OTIC  FdE  COES 

Naval  Research  Laboratory 

Washington,  DC  20375-5000 


NRL  Memorandum  Report  6351 

AD-A200  352 


EDITSPEC 

A  FORTRAN  77  Program  for 
Editing  and  Manipulating  Spectral  Data  from 
the  Varian  CARY  2390  UV-VIS-NIR  Spectrophotometer 

R.  A.  Bin  stead 

GEO-CENTERS,  Inc. 

10903  Indian  Head  Highway, 

Fort  Washington,  MD  20744 

J.  C.  Cooper 

Polymeric  Materials  Branch 
Chemistry  Division 

October  19,  1988 


Approved  for  public  release;  distribution  unlimited 


8  8  11  15  0  5  6 


la  REPORT  SECURITY  CLASSIFICATION 

UNCLASSIFIED 


2a.  SECURITY  CLASSIFICATION  AUTHORITY 


2b  DECLASSIFICATION  /  DOWNGRADING  SCHEDULE 


4  PERFORMING  ORGANIZATION  REPORT  NUMBER(S) 

NRL  Memorandum  Report  6351 


6s  NAME  OF  PERFORMING  ORGANIZATION 

Naval  Research  Laboratory 


6c  ADDRESS  (Ofy,  Star*,  and  SIP  Cod*) 

Washington,  DC  20375-5000 


REPORT  DOCUMENTATION  PAGE 


'b  RESTRICTIVE  MARKINGS 


form  Approved 
OMB  No  0704-0188 


6b  OFFICE  SYMBOL 
(If  ap&ksbit) 

Code  6125 


3  DISTRIBUTION/ AVAILABILITY  OF  REPORT 

Approved  for  public  release;  distribution 
unlimited. 


5  MONITORING  ORGANIZATION  REPORT  NUM8ER(Si 


7a  NAME  OF  MONITORING  ORGANIZATION 


7b  ADORES:  [City.  Sra re  and  Code) 


8*.  NAME  OF  FUNDING /SPONSORING 
ORGANIZATION 

SDIO  and  ONR 


Be  ADDRESS  (Ofy,  Sts  f.  snd  SIP  Cods) 

Washington,  DC 


8b  OFFICE  SYMBOL  |  9  PROCUREMENT  NSTRUMENT  DE NTiFiCA TiQN  NUMBE 3 

(if  jpp/icjb/«J  I 


10  SOURCE  OF  FUNDING  NUMBERS 


WOP*  jNiT 
ACCESSION  NO 


63224C 


anUMiMrlMM  EDITSPEC  -  A  FORTRAN  77  Program  for  Editing  and  Manipulating 
Spectral  Data  from  the  Varian  CARY  2390  UV-VIS-NIR  Spectrophotometer 


12.  PERSONAL  AUTHOR(S) 

Binstead,*  R.A.  and  Cooper,  J.C. 


13..  TYPE  OP  REPORT  13b  TIME  COVERED  114  DATE  OP  REPORT  [Yelr  Month  Diy) 

Interim  prom  10/87  rp  present!  1988  October  19 


16  supplementary  notation 

*GEO-CENTERS ,  Inc.,  10903  Indian  Head  Highway,  Fort  Washington,  MD  20744 


18  SUBJECT  TERMS  (Continue  on  reverse  it  necessary  ana  identity  oy  block  number) 

UV-VIS-NIR  FORTRAN 

Editing---  -  -  CARY 

Cui,.,  v  /. 


17 

COSAT  1  cooes  ! 

|  field 

GROUP 

SUB-GROUP 

9  ABSTRACT  (Continue  on  r.vcn.  if  neceasry  ind  identify  by  bloc It  number) 

‘‘EDITSPEC  is  a  FORTRAN  77  program  designed  to  provide  a  number  of  editing  features  for- 
/UV-VIS-NIR  spectral  data  obtained  from  the  CARY  2300  -  2400  series  spectrophotometers. 
The  program  is  written  to  operate  on  a  Hewlett-Packard  1000  computer  system  but  with  very 
few  system  dependent  features  to  enable  easy  conversion  for  operation  on  other  host  systems. 
EDITSPEC  provides  facilities  for  correction  of  experimental  artifacts  and  incorrect  file 
descriptors  and  also  includes  calculation  routines  for  smoothed,  first  derivative  and  second 
derivative  spectra.  The  program  produces  new  disk  files  in  either  the  Cary  format  or  in 
simple  ASCII  X.Y  format  for  export  to  curve  fitting  programs.  l  /- 


20  DISTRIBUTION/ AVAILABILITY  OP  ABSTRACT  2'  ABSTRACT  SECURlT*  CLASSY  CATION 

□  unclassipied/unlimited  (3  same  as  rpt  □  otic  users  UNCLASSIFIED 


22  .  NAME  OP  RESPONSIBLE  INDIVIDUAL  122b  "SlEPmONE  (Include  Ate*  Coat  I  22  c  ■ -vhi'. 

~onn  C.  Cooper  76  7_r i  ;  s  Code  6125 


OO  Form  1473  JUN  86  °rPv  Ou<  !;ans  die  otSOterp  ,  f  7  .  n  1  *  v  •„  „  A S > - 7  C  '■  ~  __  *  *  ' 

S/V  rt 102-LF-0 14-boO  J 


CONTENTS 


Section 

Description 

Page 

INTRODUCTION 

1 

SOFTWARE  DESCRIPTION 

1.0 

Purpose  Of  EDITSPEC 

2 

1.1 

Smoothing  And  Derivative  Spectra 

4 

1.2 

Numerical  Least  Squares  Procedures 

5 

IMPLEMENTATION 

2.0 

Program  Structure 

6 

2.1 

File  Editing  Menu  Commands 

11 

2.2 

Data  Editing  Menu  Commands 

12 

2.3 

COMMON  DATA 

15 

2.4 

SUBROUTINES 

16 

2.5 

FUNCTIONS 

19 

2.6 


SPECIAL  SYSTEM  CALL 


19 


cont‘d 


Section 

Description 

Page 

PROGRAM  CODE 

3.0 

Source  Code  Availability 

20 

3.1 

Variable  Names  And  Usage 

20 

3.2 

Program  Listing 

26 

APPENDIX  I 

Sample  Smoothed  Spectra 

58 

APPENDIX  II 

Sample  Derivative  Spectra 

61 

LIST  OF  TABLES 

TABLE 

Description 

Page 

I 

Data  File  Format 

S 

II 

Glossary  Of  Integer  Variables 

21 

III 

Glossary  Of  Real  Variables 

IV 

Glossary  Of  Real  Array  Variables 

23 

V 


Glossary  Of  Character  Variables 


24 


EDITSPEC 

A  FORTRAN  77  Program  For  Editing  And  Manipulating  Spectral  Data  From 
The  Varian  CARY  2390  UV-VIS-NIR  Spectrophotometer 

INTRODUCTION 

Spectral  data  acquisition  from  the  CARY  2300  and  2400  series  spectrophotometers  has 
been  implemented  successfully  with  a  Hewlett-Packard  1000  minicomputer  system  using  the 
FORTRAN  77  program,  CARYSPEC,  and  its  companion  plotting  program,  PLOTSPEC,  which 
are  described  in  separate  reports.  The  ability  to  acquire  high  quality  UV-VIS-NIR  spectra 
must  be  complemented  with  flexible  analytical  software  to  make  full  use  of  the  spectroscopic 
data.  This  report  describes  a  fully  tested  FORTRAN  77  program,  EDITSPEC,  which  fulfills 
the  data  editing  and  manipulation  requirements  of  most  users  in  a  simple  to  use  menu  driven 
environment.  The  program  reads  and  manipulates  disk  data  files  in  Absorbance  or 
%  Transmission  modes  vs  Wavelength  (nm)  and  stores  the  edited  data  in  the  same  format  or 

in  a  simple  ASCII  X,Y  format  for  use  by  curve  fitting  programs. 

The  editing  facilities  provided  in  EDITSPEC  allow  for  easy  corrections  to  both  inaccurate 
file  descriptors  and  anomalies  in  the  spectral  data.  Single  data  points  may  be  altered  to 
remove  a  glitch  or  a  segment  of  a  spectrum  may  be  offset  to  produce  exact  matching 

between  regions  obtained  using  different  photodetectors  or  lamp  sources.  Nonlinearity  of  Near 
IR  data  from  the  PbS  detector  can  be  corrected  in  cases  where  the  data  extend  below  800 
nm  in  AUTOSELECT  mode.  The  absorbance  offset  between  the  Photomultiplier  and  PbS 

detectors  at  800  nm  is  used  to  icscale  the  Near  IR  region  assuming  that  the  PM  tube 
response  is  perfect.  The  Cary  2300  series  instruments  can  benefit  most  from  this  rescaling 
routine.  The  Cary  2400  series  instruments  already  provide  nonlinearity  correction  for  the 
standard  PbS  detector  though  this  feature  is  bypassed  for  the  reflectance  accessory  which 
suffers  badly  from  nonlinearity.  EDITSPEC  also  provides  quartic  polynomial  least  squares 
calculation  routines  to  produce  Smoothed,  First  Derivative  and  Second  Derivative  spectra. 

EDITSPEC  has  been  developed  for  use  with  an  HP  1000  minicomputer  system  running 
the  RTE-6/VM  operating  system  and  ci  shell.  The  program  resides  in  a  single  32K  word 
memory  segment  and  utilizes  98K  words  of  Extended  Memory  Addressing  (EM A)  area  for  the 
large  data  arrays.  Since  EDITSPEC  makes  use  of  very  few  special  features  of  the  HP  1000 
computer  system  the  program  could  be  modified  easily  to  run  on  other  host  systems 
supporting  the  FORTRAN  77  language. 


SOFTWARE  DESCRIPTION 


1.0  Purpose  Of  EDITSPEC: 

The  data  acquisition  program  CARYSPEC  was  designed  to  store  only  baseline  corrected 
UV-VIS-NTR  spectra  in  disk  files  which  should,  hopefully,  be  free  of  all  instrumental 
artifacts.  In  practice,  some  small  irregularities  can  still  occur  at  grating,  lamp  or  detector 
change  over  points  and  EDITSPEC  provides  the  user  with  both  single  datum  and  region  offset 
commands  to  remove  such  artifacts  albeit  in  an  arbitrary  fashion.  Discretion  is  left  to  the 
user  for  determining  which  spectral  region  is  likely  to  have  been  incorrectly  recorded  by  the 
particular  instrument.  The  Cary  2400  and  upgraded  2300  series  spectrophotometers  are  less 
likely  to  require  such  manipulation  since  these  instruments  have  more  reproducible  mechanical 
positioning  for  the  photodetectors. 

The  data  files  produced  by  CARYSPEC  include  a  number  of  file  description  strings  and 
numeric  variables  to  provide  permanent,  internal  documentation  for  the  spectrum.  Occasionally, 
important  information,  such  as  solute  concentration,  is  not  known  at  the  time  of  data 

collection  and  EDITSPEC  provides  an  easy  means  of  displaying  and  updating  the  file 

descriptors.  Since  EDITSPEC  also  provides  a  number  of  data  transformation  routines,  the 
edited  spectrum  can  be  stored  on  disk  only  with  a  new  filename.  This  prevents  inadvertent 
loss  of  the  original  data. 

EDITSPEC  supports  such  file  operations  as  file  size  reduction,  nonlinearity  correction  for 
Near  IR  data  and  numerical  procedures  for  smoothing  or  experimental  noise  and  calculation  of 
derivative  spectra.  The  file  size  reduction  operation  allows  new  wavelength  limits  and  data 

step  size  to  be  set,  which  is  useful  for  matching  spectra  to  be  used  in  the  difference 

spectrum  mode  of  PLOTSPEC.  Near  IR  data  often  suffer  from  nonlinearity  of  the 

photoconductive  PbS  detectors  used  in  the  Cary  2300  series  spectrophotometers.  Corrections  for 
such  nonlinearity  are  dependent  on  both  the  light  flux  and  the  absorbance  level.  The  Cary 

2400  and  upgraded  2300  series  instruments  provide  appropriate  correction  in  the  Near  IR 

region  for  the  standard  PbS  detector.  However,  detectors  on  external  modules,  such  as  the 
Diffuse  Reflectance  accessory,  are  not  corrected.  Reflectance  spectra  often  show  discontinuities 
between  the  PbS  and  PM  tube  detectors  at  800  nm  and  EDITSPEC  provides  a  simple 
rescaling  procedure  to  produce  detector  matching  in  these  cases.  This  is  not  meant  to  be  a 
panacea  but  it  does  provide  a  more  realistic  result  than  the  raw  data. 
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Experimental  noise  is  not  often  a  problem  with  UV-Visible  spectra  from  the  Cary 
spectrophotometers.  However,  the  Near  IR  region  is  more  noise  prone,  particularly  with  the 
Diffuse  Reflectance  accessory,  due  to  the  poorer  signal  to  noise  ratio  of  PbS  detectors  and 
the  low  efficiency  of  the  rather  small  integrating  sphere.  In  such  cases  it  may  be  desirable  to 
use  the  quartic  polynomial  least  squares  smoothing  routines  in  EDITSPEC.  This  standard 
procedure  has  been  specially  modified  to  suit  the  large  data  redundancy  in  most  UV-VIS-NIR 
spectra  and  can  be  used  to  remove  both  random  noise  and  spurious  artifacts  from  solvent 
overtone  bands  in  the  Near  IR  region. 

The  polynomial  least  squares  procedure  is  also  utilized  in  EDITSPEC  to  calculate  First 
and  Second  Derivative  spectra  with  a  higher  degree  of  precision  than  the  analog  versions 
which  the  Cary  spectrophotometers  produce  on  their  internal  pen  recorders.  These  routines 
can  provide  useful  information  in  regions  of  overlapping  absorption  bands.  The  resulting  First 
and  Second  derivative  spectra  are  arbitrarily  scaled  by  factors  of  xlO  and  xlOO,  respectively, 
to  facilitate  subsequent  plotting  using  the  program  PLOTSPEC. 

EDITSPEC  also  supports  the  creation  of  simple  ASCII  X,Y  text  files  for  exporting  data 
to  general  purpose  curve  fitting  software.  In  this  mode  the  abscissa  values  are  converted  from 
Wavelength  (nm)  to  Energy  units  (cm*1)  on  output  with  approximately  even  Wavenumber 
spacing  between  points.  The  user  may  select  either  Absorbance  or  Extinction  Coefficient '  (M*1 
cm*1)  units  for  the  ordinate  and  the  program  will  automatically  rescale  %  Transmission  data 
to  the  selected  ordinate,  if  required. 

Finally,  EDITSPEC  provides  a  facility  for  subtraction  of  a  reference  baseline  spectrum 
for  cases  in  which  the  pure  solvent  (in  transmittance  mode)  or  reflectance  standard  does  not 
provide  a  suitable  baseline  for  the  sample  under  study.  For  example,  thin  films  on  substrates 
or  matrix  isolated  materials  will  usually  require  correction  for  the  absorption  or  reflectivity  loss 
of  the  substrate.  The  baseline  data  File  may  cover  the  same  or  a  larger  wavelength  range 
than  the  File  to  be  corrected  but  both  must  have  the  same  data  interval  size,  ordinate  scale 
and  reference  beam  modes.  These  restrictions  are  intended  to  ensure  that  such  baseline 
corrections  are  carried  out  under  closely  matched  instrumental  conditions. 

The  combination  of  facilities  offered  by  EDITSPEC  should  satisfy  the  needs  of  most 
users  for  producing  high  quality  spectra  free  from  instrumental  and  sample  handling  artifacts. 
The  operation  of  each  facility  will  be  discussed  separately  in  more  detail  below. 


1.1  Smoothing  And  Derivative  Spectra: 

The  numerical  procedures  used  in  EDITSPEC  for  smoothing  experimental  noise  and  for 
calculating  derivative  spectra  are  based  on  standard  polynomial  least  squares  regression.  The 
method  relies  on  fitting  a  high  order  polynomial,  (a0  +  aj  x  +  a2  x2  +  a3  x3  +  a4  x4  +  ...  ) 
to  small  data  segments,  (-x,...,+x),  replacing  the  centre  point  (x  =  0)  with  the  fitted  values 
of  a0  (smoothing),  at  (first  derivative),  2 a2  (second  derivative)  ...  etc.  The  data  segment  is 

stepped  consecutively  across  the  spectrum  to  complete  the  procedure.  EDITSPEC  uses  a 
quartic  polynomial  routine  with  choices  of  7,  11,  15,  21  and  25  point  segments  to  provide 
increasing  levels  of  local  averaging.  The  procedure  is  illustrated  below  for  a  7  point  segment: 

...  o  |o  0  o  •  o  o  °|  «  ••• 

Index:  -3-2-1  0  1  2  3 

Smoothing: 

The  data  interval  (-3,. ..,+3)  is  fitted  to  a  quartic  polynomial  to  calculate  a  new  centre 
point  a0  denoted  by  •.  The  complete  spectrum  is  smoothed  by  stepping  the  7  point 
segment  consecutively  across  the  spectrum  but  the  procedure  obviously  can  not  smooth 

the  first  or  last  3  points.  The  smoothing  procedure  may  be  repeated  as  many  times  as 
desired  and  may  be  limited  to  just  a  small  region  of  the  complete  spectrum. 

Derivatives: 

An  obvious  extension  to  the  polynomial  regression  technique  is  the  easy  calculation  of 
derivative  spectra  with  replacement  of  the  centre  point  by  the  fitted  values  of  a,,  2a 2, 
...  n\an  etc.  for  the  first,  second  and  higher  derivatives. 

The  technique  can  only  average  noise  (in  the  least  squares  sense)  within  the  width  of  the 
selected  interval  so  that  with  closely  spaced  data  even  the  25  point  fit  may  be  ineffective. 
For  example.  Near  IR  spectra  often  display  the  effects  of  significant  1/f  noise  with  an 

effective  noise  period  of  20  nm  or  more  underlying  a  higher  level  of  more  random  noise.  A 
naive  implementation  of  the  smoothing  procedure  will  fail  to  deal  with  very  low  frequency 
noise,  removing  only  the  more  rapid  fluctuations.  EDITSPEC  allows  the  user  to  span  an 

arbitrarily  wide  wavelength  range  for  each  fitted  segment  by  evenly  spacing  the  fitted  points 
with  an  integral  number  of  data  points.  This  results  in  vastly  superior  global  averaging. 
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1.2  Numerical  Least  Squares  Procedures: 


The  quartic  polynomial  regression  equations  can  be  written  in  matrix  form  as  follows: 
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or  in  matrix  notation  as  Q  ■  K  =  g  ,  where  kn  =  nlan,  for  which  the  solution  vector  is 
given  by  £  =  Q~l  •  S-  Evaluation  of  the  the  inverse  coefficient  matrix  is  simplified  using  the 
range  of  index  values  (-x,...,-l  ,0,+l  ,...,+x)  to  represent  the  data  interval  to  be  fitted  to  the 
polynomial  since  all  the  summations  for  odd  powers  of  x  are  zero.  The  resulting  solution 
vector  simplifies  to  a  set  of  known  coefficients  times  fi  which  needs  to  be  evaluated  for  each 
data  segment.  EDITSPEC  requires  the  elements  of  just  the  first  three  rows  of  £“l,  comprising 
8  non-zero  elements  of  which  7  are  unique.  A  full  pivoting  Gaussian  elimination  matrix 
inversion  program  was  used  to  solve  for  the  coefficients  and  these  appear  as  Double  Precision 
DATA  for  array  CC(I,J)  in  EDITSPEC  for  the  5  different  fitting  algorithms  provided. 

The  general  solutions  for  the  smoothing  and  derivative  calculations  in  EDITSPEC  are 
summarized  below: 


SMOOTraNG: 

ko  =  Q-\i,i)-Zy  + 

DERIVATIVE  1: 

ki  *  + 

(3,i)'z  y  +  £r](3j) 


(3J) 


■Ix*y 


DERIVATIVE  2: 


*2  =  Q-\ 


•Ex2y  +  Q-\ 


IMPLEMENTATION 


2.0  Program  Structure: 

EDITSPEC  comprises  a  large  main  program  unit  containing  the  console  menu  displays 
and  string  data  for  the  instrument  settings  variables.  A  number  of  subroutines  perform  input 
validation  and  string  processing  commands  absent  from  the  FORTRAN  77  language.  The  main 
program  unit  of  EDITSPEC  comprises  6  distinct  segments  of  code  to  carry  out  the  the 
functions  of  disk  file  data  retrieval,  instrument  settings  display,  editing  of  File  descriptors  and 
spectral  data,  data  file  storage  and  file  creation  for  exporting  ASCII  X,Y  data  to  curve  fitting 
programs  etc.  The  code  fragments  appear  under  the  following  assigned  labels:  MENU,  READ, 
SETTINGS,  EDIT,  STORE,  CURFILE  and  EXIT. 

MAIN  PROGRAM 


MENU: 

This  is  the  first  and  main  control  menu  of  the  program,  selecting  entry  to  the  data 
retrieval,  instrument  settings,  editing,  data  file  storage  and  exit  routines.  The  choices  are 
as  follows: 

’R’  . Read  Spectrum 

This  command  causes  a  branch  to  label  READ  and  the  program  performs  a  logical 
test  for  the  presence  of  a  valid  spectrum  in  memory  before  allowing  previous  data 
to  be  overwritten  by  a  new  file.  If  a  spectrum  is  already  present  in  memory  the 
user  may  elect  to  overwrite  the  old  data ,  subtract  a  baseline  reference  file  or 
return  to  the  main  menu.  The  data  file  format  is  listed  below  in  Table  I.  Spectra 
are  read  into  the  data  arrays  X,Y  while  baseline  files  are  stored  in  the  arrays 
XB,YB  before  subtraction  takes  place. 

’I’  . Instrument  Settings 

This  option  branches  to  label  SETTINGS  and  performs  logical  tests  for  the 
presence  of  spectrum  and  baseline  data  files  in  memory.  This  routine  allows  for 
display  of  the  most  important  operating  conditions  of  the  Cary  2390 
spectrophotometer  during  acquisition  of  the  selected  data  file  to  provide  an  on-line 
reference  when  comparing  data  files. 


« 


« 


« 
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’E’  . Edit  Spectrum 

Entry  of  this  command  causes  a  branch  to  label  EDIT.  The  program  then 
performs  a  logical  test  for  the  presence  of  a  valid  spectrum  in  memory  before 
presenting  a  sub— menu  of  editing  options.  All  the  data  manipulations  are  performed 
from  these  sub-menus. 

’S’  . Store  Spectrum 

This  command  transfers  control  to  label  STORE  where  logical  tests  are  performed  ^ 

for  the  presence  of  a  spectrum  in  memory  and  whether  the  data  file  to  be  created 
is  an  edited  or  smoothed  spectrum.  The  data  files  are  stored  in  the  Cary  format 
for  subsequent  use  by  the  plotting  program  PLOTSPEC. 

l 

’D’  . Store  Derivative  Spectrum 

This  command  also  branches  to  label  STORE  but  in  this  case  the  program  also 
checks  for  the  presence  of  a  derivative  array  in  memory  before  proceeding.  First 
and  second  derivative  spectra  are  also  stored  in  the  Cary  format  but  are  scaled 
arbitrarily  xlO  and  xlOO,  respectively,  to  simplify  subsequent  plotting. 

’C’  . Store  Curve  Fitting  File 

This  option  allows  for  creation  of  simple  ASCII  X,Y  data  files  from  Cary  spectra. 

The  program  branches  to  label  CURFILE  and  prompts  for  entry  of  the  wavelength 
range  in  the  new  data  file  and  the  number  of  data  points  required  (10  -  500). 

The  abscissa  values  are  converted  from  Wavelength  (nm)  to  Energy  units  (cm-1) 
and  the  program  selects  data  points  to  be  spaced  evenly  in  cm-1.  The  ordinate 
data  can  be  Absorbance  or  Extinction  Coefficients  only  and  automatic  rescaling  is 
provided  for  %  Transmission  data. 

’X’  . Exit 

The  final  option  causes  a  branch  to  the  label  EXIT  which  checks  whether  the 
spectrum  in  memory  has  been  saved  to  disk  before  allowing  the  program  to 
terminate. 
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TABLE  I 

Data  File  Format 


Line 

File  Variables  a 

Format  Type  b 

l 

LABEL(2) 

CHARACTER  (A72) 

2 

DATE(2) 

CHARACTER  (A 8) 

3 

XMIN(2),XMAX(2),XSTEP(2),CONC(2), 

PATH(2) 

REAL  (*) 

4 

ORD(2),ABSC(2),CELL(2),CYCLE(2), 

SAMPLE(2),WAVE(2),TIMER(2), 

TEMP(2)  ,DIST  (2) 

REAL  (*) 

5 

NP,NV,ND(2) 

INTEGER  (13,13,16) 

6-54 

PARAM(2,I) 

INTEGER  (12) 

55 

VARIABLE(2,I) 

REAL  (*) 

56-/ 

Y(I)  or  YB(I) 

REAL  (*) 

/-eof 

X(I)  or  XB(I) 

REAL  (*) 

a:  Disk  data  files  are  read  into  either  half  of  the  data  arrays 


b: 


(*) 


< 


indicates  free  field  format 


I 
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READ: 


This  section  of  EDITSPEC  opens  a  disk  file  previously  stored  by  the  data  acquisition 
program  CARYSPEC.  The  data  are  stored  in  ASCII  code  and  contain  a  complete 
description  of  the  instrument  parameter  settings  as  well  as  the  spectral  data.  The  format 
of  the  data  file  is  listed  above  in  Table  I.  The  program  prompts  the  user  for  both  the 
filename  and  subdirectory.  The  filename  may  be  up  to  16  characters  with  the  extension 
".Sxx",  where  xx  are  the  researcher’s  initials.  The  subdirectory  defaults  to  the  user's 
directory  if  only  a  RETURN  character  is  entered.  If  a  directory  name  is  given  the 
program  builds  a  complete  Cl  pathname  for  use  in  the  OPEN  statement.  If  the  file 
cannot  be  found  or  the  file  is  already  open  the  program  displays  an  error  message  and 
then  returns  to  the  main  MENU.  Otherwise,  the  file  is  read  and  the  file  descriptors  are 
displayed  on  the  console  while  the  remainder  of  the  data  are  being  transferred.  The 
program  then  returns  to  the  main  MENU. 

SETTINGS: 

This  section  of  code  displays  a  list  of  the  most  important  instrument  settings  of  the  Cary 
2390  spectrophotometer  during  acquisition  of  the  specified  data  file.  The  program  includes 
a  large  amount  of  string  data  for  the  various  settings  in  the  CHARACTER  array  Pstr. 
The  INTEGER  array  PARAM  is  used  as  an  index  to  this  string  data  while  numeric  data 
for  the  table  are  obtained  from  the  REAL  array  VARIABLE.  If  both  a  Spectrum  and 
Baseline  are  present  in  memory  the  program  will  prompt  for  which  settings  to  display. 

EDIT: 

This  section  of  code  contains  two  sub-menu  displays  for  performing  all  the  data  and  file 
manipulations  within  EDITSPEC.  The  first  sub-menu  allows  for  alterations  to  the  file 
descriptors  comprising  the  variables  Concentration  (M),  Date  (MMIDDIYY),  Label  (72 
chars)  and  Pathlength  (cm)  using  single  letter  command  entries.  The  remaining  choices 
select  entry  to  the  data  editing  menu  or  an  exit  to  the  main  MENU.  The  data  editing 
menu  supports  the  following  functions:  List  Data  Segment,  Edit  Single  Datum,  Offset 
Segment,  Near  IR  Rescale,  Smooth  Segment  and  ueriv.  Spectra.  The  operation  of  these 
functions  is  straightforward  and  each  is  described  in  detail  below  (Sections  2.1 -2.2). 
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STORE: 


This  section  of  EDITSPEC  provides  the  data  storage  routine  for  edited,  smoothed  and 
derivative  spectra.  On  entry  to  this  routine  the  program  checks  if  a  spectrum  is  present 
in  memory.  Otherwise,  an  error  message  is  displayed  before  returning  to  the  main 
MENU.  If  the  Store  Derivative  Spectrum  command  has  been  used  to  enter  this  routine 
then  a  check  is  also  made  for  the  presence  of  a  valid  derivative  array.  If  the  data  file 
to  be  stored  is  a  smoothed  or  a  derivative  spectrum  then  the  file  description  label  is 
altered  to  include  the  number  of  smoothing  passes  (SMxx:  ...)  or  the  degree  of  the 
derivative  calculation  (FD:  ...  or  SD:  ...).  The  user  is  only  prompted  for  initials, 
filename  and  subdirectory  information  before  the  file  is  written  to  a  disk  file.  Standard 
I/O  error  checking  for  a  FILE  EXISTS  or  a  FILE  OPEN  error  is  performed  during  file 
creation.  The  program  then  returns  to  the  main  MENU  with  the  new  filename  and  file 
status  variables  for  the  edited  spectrum. 


CURFILE: 

This  section  of  code  provides  a  simple  means  of  exporting  spectral  data  to  curve  fitting 
programs  etc.  The  files  are  created  in  an  ASCII  X,Y  format  with  no  other  information 
except  the  end-of-file  marker.  The  abscissa  values  are  converted  from  Wavelength  to 
linear  Energy  units  (cm-1)  and  the  program  selects  data  so  that  the  spacing  between 
abscissa  values  is  nearly  even  in  cm*1  units.  The  program  provides  an  arbitrary  range  of 
10  -  500  data  points  for  such  files  which  should  suit  the  needs  of  most  ancillary 
programs.  The  ordinate  mode  can  be  selected  as  Absorbance  or  Extinction  Coefficient 
only  and  if  the  original  data  were  collected  in  %  Transmission  mode  then  automatic 
rescaling  is  performed  during  the  data  storage  loop.  Standard  I/O  error  checking  is 
performed  for  a  FILE  EXISTS  or  a  FILE  OPEN  error  during  file  creation.  The  program 
then  returns  to  the  main  MENU  with  an  updated  status  variable  for  the  Store  Curve 
Fitting  File  command. 


EXIT: 

The  final  portion  of  EDITSPEC  checks  whether  a  valid  spectrum  in  memory  has  been 
stored  to  disk  before  allowing  the  user  to  terminate  the  program.  The  routine  does  not 
check  the  status  of  Derivative  arrays  or  Curve  Fitting  files  since  these  can  be  easily 
recreated  from  the  stored  spectral  data  file. 
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2.1  File  Editing  Menu  Commands: 


The  first  editing  sub-menu  is  designed  to  allow  for  easy  alterations  to  the  file 
descriptors.  The  operations  are  invoked  using  single  letter  commands  as  follows; 

’C’  . Concentration,  (M) 

The  Concentration  variable  is  used  to  scale  experimental  absorbance  values  from  solution 
spectra  into  Molar  Extinction  Coefficients  (absorptivity)  units  and  may  need  to  be  altered 
if  the  value  was  unknown  at  the  time  of  data  collection. 

’D’  . Date,  (MM/DD/YY) 

The  Date  variable  is  set  manually  within  the  data  collection  program,  CARYSPEC,  and 
may  need  to  be  altered  if  it  has  been  entered  incorrectly.  Only  8  character  positions  are 
provided  for  this  entry. 

’L’  . Label,  (72  chars) 

This  variable  provides  descriptive  text  to  document  the  nature  of  the  spectrum.  The 
maximum  text  length  is  72  characters  and  the  character  field  is  delimited  on  the  console 
screen  by  arrow  heads  under  the  text  entry  line. 

?’  . Pathlength,  (cm) 

This  variable  is  also  used  in  the  calculation  of  Extinction  Coefficient  values  for  solution 
spectra.  In  other  types  of  spectra  this  variable  can  be  set  to  zero. 

The  data  entry  routine  is  arranged  in  such  a  way  that  the  current  value  of  a  variable  is 

printed  to  the  console  screen  with  the  cursor  placed  over  the  first  character  of  the  old  value. 
Entry  of  only  a  RETURN  character  will  keep  the  old  value  intact.  If  any  other  characters 

are  entered  they  are  treated  as  the  new  value.  Thus,  a  complete  line  must  be  entered  to 

update  the  previous  data  correctly.  Cursor  control  keys  should  not  be  used  in  editing  such 
line  entries  -  the  backspace  key  is  the  only  editing  function  permitted. 

The  remaining  command  entries  'S'  and  'X'  are  used  to  enter  the  data  editing  sub-menu 
or  to  exit  to  the  main  MENU. 
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2.2  Data  Editing  Menu  Commands: 

The  spectral  data  editing  sub-menu  provides  access  to  all  the  array  manipulation 
functions  available  in  EDITSPEC.  In  common  with  the  other  menus,  single  letter  commands 
are  used  to  select  the  desired  operations  given  below: 

’L’  . List  Data  Segment 

This  command  provides  a  means  of  inspecting  the  data  between  any  two  selected 
wavelength  limits.  The  data  are  displayed  in  pages  of  10  points  until  completion.  If  the 
original  data  were  acquired  in  Absorbance  mode  this  routine  lists  both  the  Absorbance 
and  Extinction  Coefficient  values  vs  Wavelength  (nm).  In  %  Transmission  mode  only  the 
raw  data  are  presented. 

’E’  . Edit  Single  Datum 

This  command  is  used  to  display  and  update  Absorbance  or  %  Transmission  data  at  a 
single  wavelength.  The  current  value  is  printed  on  the  screen  with  the  cursor  positioned 
over  its  first  character.  Entry  of  only  a  RETURN  character  will  keep  the  current  value 
intact.  Otherwise,  a  new  entry  is  assumed  for  any  other  characters  read  from  the 

keyboard.  New  entries  are  validated  to  lie  within  the  range  -0.5  to  4.5  for  Absorbance 

mode  and  0  to  200  for  %  Transmission  mode.  The  latter  also  covers  the  case  of 
%  Reflectance  spectra. 

’O’  . Offset  Segment 

The  offset  command  enables  corrections  to  be  made  for  misalignment  between  regions  of 
a  spectrum  obtained  using  different  detectors,  gratings  or  source  lamps.  The  routine 
provides  a  simple  (i)  algebraic  offset,  selected  by  the  user,  between  the  desired 
wavelength  limits  without  regard  to  the  ordinate  mode. 

’N’  . Near  IR  Rescale 

This  command  is  used  to  align  the  Near  IR  region  of  a  spectrum  with  data  obtained 
from  the  photomultiplier  detector  in  the  Visible  region.  The  data  must,  therefore,  have 
been  collected  in  AUTOSELECT  mode  so  that  the  detector  change  is  made  at  800  nm. 
The  routine  inspects  the  last  point  obtained  with  the  PbS  detector  and  the  first  point 

from  PM  tube  to  obtain  a  default  offset  value.  The  default  value  is  written  to  the 

console  display  with  the  cursor  positioned  over  its  first  character  and  entry  of  just  a 
RETURN  character  will  commence  rescaling  with  this  offset. 
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This  routine  is  most  often  used  to  align  noisy,  high  absorbance  Near  IR  data  with  a 
noise  free  Visible  region  so  that  it  proves  more  useful  to  plot  the  data  first  to  obtain  a 
better  estimate  for  the  offset  before  rescaling.  The  rescaling  procedure  is  multiplicative 
for  both  Absorbance  and  %  Transmission  modes.  Ideally,  the  latter  should  be  convened 
to  Absorbance  before  rescaling  but  this  is  not  likely  to  cause  any  serious  errors. 

. Reduce  File  Size 

This  command  is  used  to  change  the  size  of  a  data  file  by  reducing  the  wavelength 
range  or  by  increasing  the  step  size  (nm)  between  data  points.  This  is  most  useful  in 
providing  matched  data  files  for  the  spectral  subtraction  mode  of  the  plotting  program, 
PLOTSPEC.  It  may  also  be  useful  for  eliminating  excess  data  from  very  large  files.  The 
reduced  file  overwrites  the  current  spectrum  and  recovery  is  possible  only  by  reading  the 
old  data  from  disk. 

. Smooth  Segment 

The  quartic  polynomial  smoothing  routine  in  EDITSPEC  is  provided  with  data  for 
calculations  with  5  different  levels  of  local  averaging  using  data  segments  with  7,  11,  15, 

21  or  25  points  (-XX... .,0 . +XX)  in  the  least  squares  fits.  These  are  selectable  from 

the  smoothing  algorithm  menu  which  is  presented  on  entry  to  the  routine.  The  program 
then  displays  the  wavelength  range  of  the  fitted  segments  with  a  default  integer  step  size 
of  two  points.  The  user  may  increase  or  decrease  the  wavelength  range  of  the  fitted 
segments  by  altering  the  step  size  variable.  Larger  values  of  the  step  size  produce 
improved  global  averaging,  an  important  feature  for  removing  non-random  solvent 
overtone  artifacts.  The  smoothing  routine  may  be  applied  over  the  whole  wavelength 
range  or  just  within  a  small  segment.  However,  the  routine  can  not  smooth  the  first  or 
last  XX  data  points  in  the  spectrum.  The  program  prints  the  actual  range  smoothed  on 
the  console  screen  before  prompting  for  the  number  of  smoothing  passes.  There  is 
nothing  to  be  gained  by  performing  a  large  number  of  smoothing  passes  with  the  same 
algorithm.  Rather,  it  is  preferable  to  select  several  different  fitting  intervals,  by  choice  of 
algorithm  and  step  size,  to  improve  the  averaging  of  low  frequency,  non-random  noise. 
In  general,  it  is  wise  to  finish  a  smoothing  procedure  with  the  integer  step  size  set  to  1 
data  point  to  suppress  a  tendency  to  produce  periodic  oscillations  in  the  data  with  the 
polynomial  regression  procedure. 

Some  examples  of  smoothed  spectra  appear  as  an  appendix  to  this  report. 


’D’  .....Derivative  Spectra 

The  polynomial  regression  technique  in  EDITSPEC  is  also  used  to  calculate  first  and 
second  derivative  spectra.  Smoothing  may  be  performed  prior  to  the  derivative 
calculations  in  order  to  reduce  the  noise  level,  particularly  for  the  second  derivative. 
Selection  of  the  fitting  algorithm  is  identical  to  the  procedure  for  smoothing.  However, 
the  procedure  can  be  performed  only  once  and  must  encompass  the  entire  wavelength 
range,  less  the  first  and  last  XX  data  points.  The  latter  are  set  equal  to  the  first  and 
last  fitted  points,  respectively.  It  is  most  beneficial  to  provide  wide  global  averaging  for 
the  derivative  functions  with  fitted  intervals  on  the  order  of  20-S0  nm.  If  the  fitted 
interval  is  too  narrow  then  the  result  is  a  measure  of  the  point  to  point  noise  level  and 
not  the  derivative  of  the  spectrum  per  se. 

Some  examples  of  derivative  spectra  appear  as  an  appendix  to  this  report. 
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2.3  COMMON  DATA: 

All  COMMON  array  variables  used  by  EDITSPEC  are  held  in  a  named  COMMON 
block,  /DATA /.  The  arrays  contained  within  the  COMMON  block  are  listed  below. 


/DATA/  Contains  EMA  REAL  Arrays  of  spectroscopic  data 

X  Array  containing  the  spectrum's  Wavelength  data  (nm) 

Values  read  from  disk  data  file 
Values  used  in  main  program  unit 

Y  Array  containing  the  spectrum's  Absorbance  or  %T  data 

Values  read  from  disk  data  file 
Values  used  in  main  program  unit 


XB  Array  containing  the  baseline's  Wavelength  data  (nm) 

Values  read  from  disk  data  file 
Values  used  in  main  program  unit 

YB  Array  containing  the  baseline's  Absorbance  or  %T  data 

Values  read  from  disk  data  file 
Values  used  in  main  program  unit 


Z  Array  containing  the  derivative  spectrum's  Absorbance  or  %T  data 

Values  calculated  in  main  program  unit 
Values  stored  to  disk  data  file 


I 
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All  the  data  arrays  are  dimensioned  for  10001  data  points  maximum  in  single  precision 
and  are  specified  to  reside  in  EMA  memory  requiring  98K  words  of  system  available  memory. 
These  memory  demands  could  be  reduced  if  required  since  few  UV-V1S-NIR  spectra  have 
more  than  a  few  thousand  data  points. 
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2.4  SUBROUTINES: 


EDITSPEC  uses  subroutines  to  perform  specific  tasks  which  are  required  more  than  once, 
including  several  types  of  string  manipulation  and  input  validation.  The  purpose  and  calling 
sequences  are  listed  below: 

Center(TITLE) 

Prints  a  string  on  the  user  console  centred  within  a  72  column  line. 

TITLE  CHARACTER*72  string,  contents  set  by  calling  unit 

CALLED  BY:  Main  program  unit 
CALLS :  None 


Line(N) 

Prints  a  line  of  characters  to  the  user  console  N  columns  wide  and 
centred  within  a  72  column  line. 

N  INTEGER  variable  input  from  calling  unit 

CALLED  BY:  Main  program  unit 
CALLS :  None 


XIimits(MIN,MAX) 

Performs  an  absolute  value  function  on  the  input  arguments 
Validates  the  resulting  arguments  so  that  MIN  <  MAX 

MIN, MAX  REAL  variables  input  and  output  with  order  swapped  if  required 

CALLED  BY:  Main  program  unit 
CALLS :  None 
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Ylimits(MIN,MAX) 

Validates  the  input  arguments  so  that  MIN  <  MAX 

MIN, MAX  REAL  variables  input  and  output  with  order  swapped  if  required 

CALLED  BY:  Main  program  unit. 

CALLS :  None 

Upper(Code) 

Performs  a  check  for  lower  case  characters  in  a  string  of  arbitrary  length 
and  converts  to  upper  case  if  necessary. 

Code  CHARACTER*  (*)  variable  passed  into  routine  and  UPPER  case  on  exit 

DIMENSION  is  set  by  the  calling  unit 

CALLED  BY:  Main  program  unit 

CALLS :  None 

EXTENSION:  LEN(jrring)  function,  an  HP  extension  to  FORTRAN  77 

Str(VALUE,String,PREC) 

Performs  a  conversion  from  numeric  value  to  a  string  number  for  floating 
point  numbers  only  with  up  to  12  digits  precision. 

VALUE  REAL  variable  input  to  be  processed  by  the  routine 

String  CHARACTER*! 4  string  output  corresponding  to  VALUE 

PREC  INTEGER  variable  input  to  set  the  rounding  precision  for  string 

CALLED  BY:  Main  program  unit 

CALLS:  None 

I 
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Val(String,VALUE) 

Performs  a  conversion  from  string  to  numeric  value  for  a  string  number 
containing  up  to  10  digits  with  or  without  an  exponent. 

String  CHARACTER*^)  string  input  to  be  processed  by  routine 
DIMENSION  is  set  by  calling  unit 

VALUE  REAL  variable  output 

CALLED  BY:  Main  program  unit 

CALLS:  None 

Wait(DELAY) 

Performs  a  loop  which  tests  the  system  clock  until  DELAY  seconds  have 
elapsed.  The  routine  does  not  make  provision  for  the  special  case  at  the 
transition  to  2400  hours. 

DELAY  REAL  variable  holding  the  value  of  the  delay  period  in  seconds 

CALLED  BY:  Main  program  unit 

CALLS:  FUNCTION  Time(I) 
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2.5  FUNCTIONS: 


EDITSPEC  uses  only  one  function  subprogram  that  makes  an  EXEC  call  to  read  the 
system  time. 

Time(I) 

Performs  an  EXEC  call  to  read  the  system  clock  and  converts  the  reading  to 
seconds  and  centiseconds. 

I  Dummy  argument 

CALLED  BY:  SUBROUTINE  Wait  only 

CALLS:  EXEC(ICODE,rTIME)  system  level  command 

2.6  SPECIAL  SYSTEM  CALL: 

EDITSPEC  makes  use  of  a  system  subroutine  call  to  alter  the  width  of  data  fields  sent 
to  the  system  console.  The  record  length  is  changed  from  the  default  value  of  72  columns  to 
a  more  useful  value  of  79  in  order  to  prevent  inadvertent  screen  wrap  around. 


FFRCL(I) 

Alters  the  column  width  for  standard  output 
I  Default  value  =  72,  EDITSPEC  value  =  79 

CALLED  BY:  Main  program  unit  only 

CALLS :  None,  system  level  subroutine  call,  syntax  CALL  FFRCL(l) 
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PROGRAM  CODE 


3.0  Source  Code  Availability: 

The  source  code  for  the  program  EDITSPEC  is  a  65K  ASCII  text  file  available  on  either 
a  Hewlett-Packard  cartridge,  9  track  tape  or  an  IBM  360K  format  floppy  disk.  All  requests 
should  be  accompanied  by  the  blank  medium  desired.  A  printed  copy  of  the  source  code  is 
listed  below. 

3.1  Variable  Names  And  Usage: 

A  complete  listing  of  the  INTEGER,  REAL,  REAL  Array  and  CHARACTER  variables 
for  the  MAIN  segment  of  EDITSPEC  is  given  below  in  Tables  n,  HI,  IV  &  V,  respectively. 
The  subroutines  use  the  same  names  as  the  main  program  for  the  same  variables.  Additional 
variables  in  the  subroutines  and  simple  integers,  I-N,  are  not  documented  since  their  usage  is 
rather  obvious.  The  logical  variable  MATCH  is  used  within  the  program  when  comparing  two 
spectra  for  the  baseline  reference  subtraction  mode.  The  logical  variable  DERIV  controls  the 
operation  of  the  smoothing  routine  in  order  to  re-use  the  algorithm  selection  menu  and  then 
branch  back  to  the  derivative  calculation  routine. 


Table  II 


Glossary  of  INTEGER  Variables 


Name 

Description 

Value 

| 

CURFILE 

Assigned  Label  -  Curve  Fitting  File 

2000 

EDIT 

Assigned  Label  -  Editing  Sub-menus 

400 

EXIT 

Assigned  Label  -  Terminate  Program 

9999 

» 

MENU 

Assigned  Label  -  Main  Control  Menu 

10 

READ 

Assigned  Label  -  Read  Spectrum,  Baseline 

100 

SETTINGS 

Assigned  Label  -  Scan  Conditions 

300 

STORE 

Assigned  Label  -  Store  Spectrum 

1000 

I 

ASCII 

ASCII  equivalent  of  digits  in  Str 

48-57 

COUNT 

Number  of  smoothing  cycles  performed 

>=0 

FINISH 

Index  of  final  abscissa  value  to  edit 

1-10001 

IS 

Step  size  in  smoothing  or  derivatives 

1 -ITEST 

» 

ITEST 

Maximum  step  size  for  selected  algorithm 

see  text 

NCOL 

Number  of  screen  columns  in  menu  display 

50-70 

NDATA 

Number  of  data  points  in  spectrum 

1-10001 

NFIT 

Number  of  points  in  curve  fitting  file 

10-500 

I 

NPASS 

Number  of  smoothing  passes  to  execute 

>=1 

NP 

Number  of  parameters  to  read  from  file 

49 

kTV 

Number  of  variables  to  read  from  file 

14 

START 

Index  of  first  abscissa  value  to  edit 

1-10001 

» 

XOFF 

Index  offset  at  start  &  end  of  spectrum 

see  text 

XX 

Linear  convolution  values  in  least  squares 

see  text 

ND(2) 

Number  of  data  points  read  from  disk  file 

1-10001 

NPTS(5) 

Number  of  points  in  least  squares  fit 

7-25 

► 

PARAM(2,49) 

Instrument  operating  modes  table 

1-16 
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Table  III 


i 

I 


I 


Glossary  of  REAL  Variables 


Name 

Description 

BAND 

Spectral  Bandwidth  (nm)  -  AUTO  GAIN  mode 

EC 

Extinction  Coefficient 

FIRST 

Starting  wavenumber  value  in  X,Y  file 

GAIN 

Instrument  gain  -  AUTO  SLIT  mode 

LAST 

Ending  wavenumber  value  in  X,Y  file 

NUMBER 

General  purpose  data  entry  variable 

PMIN 

Pen  scale  minimum  limit 

PMAX 

Pen  scale  maximum  limit 

RANGE 

Wavelength  span  for  least  squares  fit 

SPACE 

Approximate  wavenumber  steps  in  X,Y  file 

.  STEP 

Step  size  (nm)  interval,  editing  mode 

W 

Wavenumber  loop  counter  in  X,Y  file  creation 

WL 

Wavelength  to  be  edited  or  displayed  etc. 

WMIN,  WMAX 

Wavelength  limits  for  spectrum  in  memory 

WN.WX 

Current  wavelength  limits  for  editing 

WOFF 

Wavelength  offsets  for  smoothing  &  derivatives 

Y1.Y2 

Ordinate  values  at  Near  IR,  Visible  change  over 

YOFF 

Absorbance  or  %T  offset,  editing  mode 

ZM 

Multiplier  for  1st  &  2nd  derivatives 

Table  IV 


Glossary  of  REAL  Array  Variables 


I 


Name 

Description 

ORD(2) 

Final  ordinate  value  in  file 

ABSC(2) 

Final  abscissa  value  in  file 

CELL(2) 

Final  cell  #  value  in  File 

CYCLE(2) 

Final  cycle  #  value  in  file 

SAMPLE(2) 

Final  sample  #  value  in  file 

WAVE(2) 

Final  wavelength  value  in  file 

TIMER(2) 

Final  time  value  in  file 

DIST(2) 

Final  distance  value  in  file 

CONC(2) 

Concentration  of  sample  (M),  from  data  file 

PATH(2) 

Pathlength  of  sample  cell  (cm),  from  data  file 

VARIABLE(2,14) 

Instrument  operating  conditions  table 

XMAX(2) 

Starting  wavelength  of  scan  (nm) 

XMIN(2) 

Ending  wavelength  of  scan  (nm) 

XSTEP(2) 

Step  size  (nm),  from  data  file 

X(10001) 

Wavelength  array  -  spectrum 

XB(lOOOl) 

Wavelength  array  -  baseline 

Y(10001) 

Absorbance,  %T  array  -  spectrum 

YB(lOOOl) 

Absorbance,  %T  array  -  baseline 

Z(10001) 

6(Abs),  6(%T)  array  -  derivative  spectrum 
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Table  V 


Glossary  Of  CHARACTER  Variables 

I 


Name 


Description 


Screen  Control: 

BELL 

CHAR(7)  bell  character 

CLR*2 

Clear  screen 

DOWN*2 

Move  cursor  down  1  line 

ESC 

CHAR(27)  escape  character 

HOME*2 

Move  cursor  to  upper  left  comer 

UP*  2 

Move  cursor  up  1  line 

File  Status: 


Cstat*10 

Curve  fitting  file  status  (STOKED) 

Dstat*10 

Derivative  spectrum  status  (STORED) 

DATE(2)*8 

Date  (mm/dd/yy) 

Fstat*10 

Edited  spectrum  status  (VALID,  STORED) 

LABEL(2)*72 

Descriptor  of  spectrum 

Pstr(49.16)*14 

Table  of  parameter  setting  names 

Einc*4 

Step  size  interval  (nm)  -  edited  spectrum 

Emax*4 

Starting  wavelength  (nm)  -  edited  spectrum 

Emin*4 

Ending  wavelength  (nm)  -  edited  spectrum 

Sinc*4 

Step  size  interval  (nm) 

Smax*4 

Spectrum  starting  wavelength  (nm) 

Smin*4 

Spectrum  ending  wavelength  (nm) 

Sname(2)*20 

Spectrum  pathname.  Cl  convention 

Sstat(2)*l  0 

Spectrum  status  (VALID,  INVALID) 

/... 
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..cont'd 


Program  Control: 
C 

Code 

Directory*  40 

Dtype 

Filespec*63 

Fit(5)*2 

Fname*20 

Icode 

HEADER*72 

Pfit*10 

String*14 

TITLE*72 

Ymode 


Literal  comma 

Menu  selection,  valid  until  reset 
User  directory  name,  Cl  convention 
Type  of  derivative  spectrum  (F  or  S) 

Full  pathname  for  file  retrieval  or  storage 
Number  of  points  used  by  fitting  algorithm 
Filename  entry  for  building  Filespec 
General  purpose  selection  key  entry 
Combined  file  label  for  data  storage 
Literal  'POINTS  FIT* 

String  to  pass  data  to  or  from  subroutines 
String  to  be  printed  to  screen 
Disk  file  ordinate  mode  -  (A  or  T) 


I 


I 

I 

I 


I 


I 

I 


I 


I 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 


FTN7X.L 
$FILES  0,1 
$EMA/DATA/ 

PROCRAM  ED ITS PEC 


C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


This  Program  Is  Designed  To  Edit  Spectral  Data  Acquired  From 
The  CARY  2390  UV-VIS-NIR  Spectrophotometer  With  CARYSPEC.RUN 

The  Program  Provides  Essential  Features  For  Removing  Artifacts 
From  Experimental  Data  With  Commands  For  Editing  Single  Points, 
Offsetting  Large  Wavelength  Regions  And  Rescaling  Near  IR  Data 
To  Correct  Mismatch  Between  The  PbS  And  PM  Tube  Detectors.  The 
Program  Also  Provides  Least  Squares  Routines  For  Calculation  Of 
Smoothed,  First  Derivative  And  Second  Derivative  Spectra. 


AUTHOR:  Dr.  Robert  A.  Binstead, 

Chemistry  Division,  Code  6125, 
Naval  Research  Laboratory, 
Washington.  D.C.  20375 
U.S.A. 


WRITTEN:  March,  1987 
VERSION:  1.8 

REVISED:  April,  1987  -  Improved  Smoothing  Routine  To  Allow 

For  Multiple  Data  Steps  Between  The 
Abscissa  Points  In  Each  Fit. 

-  Added  First  And  Second  Derivative 
Spectrum  Routines  Based  On  The  Same 
Quadratic  Polynomial  Routine. 

May,  1987  -  Added  File  Size  Reduction  Routine 

To  Enable  Exact  Matching  Of  Spectra 
For  Difference  Plotting  Mode  In  The 
Program  PLOTSPEC 


June,  1987  -  Modified  File  Name  Convention  To 

Match  The  Use  Of  Directories  By 
The  Cl  Operating  System 


August , 1987  -  Added  Data  File  Creation  Routine 

For  BANDPLOT  Curve  Fitting  Of 
Multiple  Caussians  To  Spectrum 


October, 1987  -  Added  Baseline  Correction  Routine 
For  Point  By  Point  Subtraction  Of 
A  Second  File 

-  Added  A  NIR  Scaling  Routine  To 

Match  Reflectance  Data  From  The  PbS 


I 


I 
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54  C 

55  C 

56  C 

57  C 

58  C 

59  C 

60  C 

61  C 

62  C 


January, 1988  - 


May,  1988 


Y-AXIS 


X-AXIS 


MEMORY 


June,  1988 


Absorbance 


Wavelength 


And  PM  Tube  Detectors  At  800  nm 

Added  Upper  Case  Conversion  Routine 
To  Permit  Case  Insensitive  Input 

Revised  Data  File  Creation  Routine 
To  Use  The  Simpler  (X.Y)  Format 
Required  By  BANDFIT,  An  Interactive 
Version  Of  The  Old  BANDPLOT  Program 
Removed  Unused  Block  Data  &  Arrays 
Removed  Unused  Variables  &  Trimmed 
Down  String  Data  Arrays 
Added  Facility  To  Edit  Data  Files 
Collected  In  %  Transmission  Mode 

Added  25  Point  Algorithm  To  The 
Smoothing  &  Derivative  Routines 


30,000  Words  (PROGRAM)  +  98,000  Words  EMA  (DATA) 


INTEGER  COUNT, CURFILE, EDIT, EXIT, FINISH, I S , I TEST , MENU 
INTEGER  NCOL , NDATA , NF I T , NPASS , ND ( 2 ) ,NPTS(5) , NP , NV , PARAM(2 , 49) 
INTECER  READ, SETT I NCS, START, STORE, XOFF, XX 
REAL*8  CC(5,7) ,SS(5) ,YY 

REAL  BAND. EC, F I RST, GAIN, LAST .NUMBER, PM I N.PMAX, RANGE 
REAL  SPACE, STEP, VARIABLES,  14)  , W, WL, WN, WX, WOFF.Yl  ,Y2,YOFF,ZM 
REAL  ABSC(2) ,CELL(2) ,CONC(2) ,CYCLE(2) ,DIST(2) ,ORD(2) , PATH(2) 
REAL  SAMPLE(2) ,TIMER(2) ,TEMP(2) ,WAVE(2) ,XMIN(2) ,XMAX(2) ,XSTEP(2) 
REAL  X(10001) ,Y( 10001 ),XB( 10001 ) ,YB( 10001 ) ,Z( 10001) 

LOGICAL  DER IV, MATCH 

Dimension  Screen  Control  String  Variables 

CHARACTER  BELL , CLR*2 , DOWN *2 , ERASE*2 , ESC , HOME* 2 , UP* 2 

Dimension  Program  Parameter  Variables 

CHARACTER  Cstat*10 , Dstat*10, Fstat*10 , Sstat (2)*10 
CHARACTER  Di rectory*40 , Fi 1 espec*63 , Fname*20 , Sname (2)*20 
CHARACTER  Smin*4 , Smax*4 , S i nc*4 , Emi n*4 , Emax*4 , Ei nc*4 
CHARACTER  C , Code , DATE ( 2 ) *8 , Dt  ype , F i t ( 5 ) *2 , HEADER*72 , I  code 
CHARACTER  INITI ALS*2 , LABEL(2)*72 , Pcode*2 , Pf i t*10 , Pst r (49 , 16) *14 
CHARACTER  St r i ng*l 4 , TITLE*72 , Ymode 


COMMON  /DATA/X, Y,XB, YB, Z 


07  C 
08  C 

109  C 

110  C 

111  C 


132  C 

133  C 

134  C 

135  C 

136  C 

137  C 

138  C 

139  C 

140  C 
Ml  C 

142  C 

143  C 

144  C 

145  C 

146  C 

147  C 

148  C 

149  C 

150  C 

151  C 

152  C 
151  c 

154  C 

155  C 

156  C 

157  C 

158  C 

159  C 


Smoothing  &  Derivative  Routine  Constants  For  Quart ic  Fit 


112 

C 

Smoothing 

J  -  1,3,5 

l 

113 

C 

1st  Derivative  : 

J  -  2,4 

114 

C 

2nd  Derivative  : 

J  -  3,6,7 

115 

C 

116 

c 

I  :  Segment  Size 

:  Abscissa 

Range 

:  Steps  : 

Data  Range 

117 

c 

(MIN-1) 

118 

c 

1  7 

-3,... 

,+3 

X 

-3X, _ +3X 

119 

c 

2  11 

-5,... 

.+5 

X 

-5X . +5X 

120 

c 

3  15 

-7,... 

,+7 

X 

-7X . +7X 

121 

c 

4  21 

-10,... 

,  +  10 

X 

-10X . +10X 

122 

c 

5  25 

-12,... 

,+12 

X 

-12X . +12X 

123 

c 

124 

c 

Smoothing  Of  Experimental  Spectra 

Is  Almost 

Uni  versa  1 1  y 

125 

c 

Performed  Using  A 

Polynomial  Least 

Squares 

Approximat ion 

126 

c 

Within  Small  Data  Intervals 

,  Stepped  Consecutively  Across  | 

127 

c 

The  Spectrum.  The 

Technique 

Must  Be  Applied 

Int e 1 1 i gent ly  1 

128 

c 

Since  No  Significant  Smoothing  Will  Occur  If  The  Size  Of 

129 

c 

The  Smoothing  Segments  Is  Smaller 

Than  The 

Period  Of  The  M 

130 

c 

Noise.  This  Is  A 

Part icular 

Danger 

With  Spectra  From  The 

131 

c 

Cary  2390,  Where 

Data  Are  Often  Acquired  In 

Smal 1  Steps . 

This  Program  Utilizes  Two  Complementary  Approaches  To 
Increase  The  Wavelength  Interval  Of  The  Fitted  Segments. 

The  First  Includes  More  Data  Points  Within  The  Segment  With 
Choices  Of  7,11,15,21  &  25  Point  Quartic  Polynomial  Fits  To 
Provide  Increasing  Levels  Of  LOCAL  Averaging.  The  Second 
Method  Utilizes  Multiple  Data  Steps  Between  Each  Point  In 
The  Fitted  Segments,  Allowing  For  Arbitrarily  Wide  GLOBAL 
Averaging. 

Random  Noise  Of  Shorter  Period  Than  The  Fitted  Segments  Is 
Well  Filtered  By  The  Smoothing  Routine.  However,  Non-Random 
Noise  Can  Produce  Sinusoidal  Smoothed  Spectra.  One  Means  Of 
Suppressing  These  Anomalies  Is  To  Apply  Several  Cycles  Of 
Smoothing,  Each  With  A  Different  Segment  Size  Or  With  A 
Different  Number  Of  Data  Points  In  The  Fits.  Small  Regions 
Of  Non-Random  Artifacts  Are  Best  Removed  Using  A  Large  Step 
Size  And  Large  Number  Of  Fitted  Points  For  Just  That  Region 
Followed  By  Smoothing  The  Whole  Spectrum  With  Unit  Step  Size 

The  Use  Of  Polynomial  Curve  Fitting  For  First  &  Second 
Derivative  Spectra  Is  Subject  To  Digitizing  Noise  With 
Data  Segments  Which  Cover  Only  A  Small  Wavelength  Range. 

The  7,11,15,21  &  25  Point  Algorithms  Provide  Increasing 
Levels  Of  Smoothing  At  The  Expense  Of  Spectral  Resolution. 
This  Should  Not  Be  A  Problem  As  Data  Are  Usually  Acquired 
At  Very  Small  Increments  (Large  Redundancy).  However,  The 
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160  C 

161  C 

162  C 

163  C 

164  C 

165  C 

166  C 

167  C 

168  C 

169  C 

170  C 

171  C 

172  C 

173  C 

174  C 

175  C 

176  C 

177  C 

178  C 

179  C 

180  C 

181  C 

182 

183 

184 

185 

186  C 

187 

188 

189 

190  C 

191 

192 

193 

194  C 

195 

196 

197 

198  C 

199 

200 
201 

202  C 

203  C 

204  C 

205  C 

206  C 

207  C 

208  C 

209 

210 
211 
212 


Larger  Range  Algorithms  Tend  To  Produce  A  Sinusoidal  Fit, 
Resulting  In  Very  Strange  Second  Derivative  Spectra.  This 
Can  Be  Largely  Eliminated  By  Use  Of  A  Minimum  Of  2  Data 
Points  Between  Fitting  Points,  While  Stepping  The  Routine 
1  Data  Point  At  A  Time  Across  The  Spectrum. 

A  Benefit  Of  Increased  Spacing  Between  Abscissa  Values  Is 
Better  Averaging  -  This  Also  Reduces  Spectral  Resolution 
But  Is  Still  Far  Better  Than  ANALOG  Derivative  Spectra. 

It  Is  Recommended  That  Smoothed,  First  &  Second  Derivative 
Spectra  Be  Obtained  With  Increasing  Step  Size,  e.g.  2:4:8, 
Since  Greater  Averaging  Is  Required  For  The  Derivatives. 

A  Typical  Broad  Solution  Spectrum  Will  Require  A  Fitting 
Segment  Of  25  nm  To  Be  Effective  For  Second  Derivatives. 
The  User  Must  Decide  Which  Algorithm  &  Step  Multiple  Is 
Most  Appropriate  For  The  Particular  Spectrum  But  A  General 
Guideline  Is  To  Select  A  Fitting  Interval  In  Which  There 
Is  A  Significant  Change  In  Absorbance  Or  Slope. 


DATA  (NPTS( I) ,I-l,5)/7, 11, 15,21,25/ 

DATA  (CC(1,J) , J-l , 7)/5 . 6709956709957D-1 , 2. 6256613756614D-1 , 
&-2 . 65 15151515151 D-l , -3 . 2407407407407D-2 , 2 . 2727272727273D-2 , 
&2 . 1433080808081 D-l , -2 . 1 148989898990D-2/ 

DATA  (CC(2, J) , J-l ,7)/3 . 33333333333333D-1 , 6 . 0379435379435D-2 , 
&-5 . 5361 30536 1305D-2 , -2 . 8813778813779D-3 , 1 . 7482517482517D-3 , 
&1 . 6341297591298D-2 , -6 . 07031 857031 86D-4/ 

DATA  (CC(3, J) , J-l , 7)/2 . 395159020546D-1 , 2 . 304589927 1389D-2 , 
&-2 . 0648855788175D-2 , -5 . 8306798502877D-4 , 3 . 4099027907077D-4 , 
&3 . 1838914869101D-3 , -6 . 2206670178806D-5/ 


DATA  (CC(4 , J) , J-l ,7)/l . 6923254427629D-1 , 8 . 2485070089952D-3 , 
&-7 . 3024633 194239D- 3 , -1 . 0562014757286D-4 , 6 . 0573428456051D-5 , 
&5 . 6541 148461326D-4 , -5 . 5661610043088D-6/ 

DATA  (CC(5 , J) , J-l , 7)/l . 4 1695 801 2747 8D-1 , 4 . 8623545000357D-3 , 
&-4 . 2895207765503D-3 , -4 . 3823594548232D-5 , 2 . 4987497756926D-5 , 
&2 . 3322878661008D-4 , -1 . 61 3 89724245 88D-6/ 


Initialize  String  Variables 


DATA  (Pst r( 1,1), 1-1,6)/’ ABSORBANCE’ ,"K  TRANSMISSION', 

&’ TEMPERATURE’ , '%  REFLECTANCE’ , 'CONCENTRATION' , 'EMISSION'/ 
DATA  (Pst  r (2 , I) , I -1 , 4)/' WAVELENGTH’ , 'TIME' , 'TEMPERATURE'  , 
&' DISTANCE'/ 


I, 


213  DATA  (Pstr(3, 1) , 1-1 , 11)/' OFF* , 1 0.01' , ’0.02' , '0.05' , '0. 1 ' ,  '0.2'  , 

214  &’0.5’ , ' 1.0' , '2.0' , '5.0'  . *10.0'/ 

215  DATA  Pstr(4, l)/'OFF'/ 

216  DATA  (Pstr(4, I), 1-6,15)/' 0.2’, '0.5* ,'1.0* ,'2.0' ,'5.0' , 

217  &' 10* ,'20' ,'50' ,'100' ,’200'/ 

218  DATA  (Pstr(5, I) , 1-1 ,4)/’ AUTO  SELECT' , 'AUTO  GAIN' , 'AUTO  SLIT’ , 

219  &' SINGLE  BEAM'/ 

220  DATA  (Pstr(6, I) , I-l,5)/'OFF' , 'NORMAL' ,' 1ST  DERIV’,'2ND  DERIV' , 

221  &' LOG' / 

222  DATA  (Pst r(7 , I ) , 1-1 , 9)/' 0 . 01 ' ,'0.02', '0.05 ','0.1', '0.2', '0.5', 

223  &’1.0' ,'2.0' ,'4.0'/ 

224  DATA  (Pst r (8 , I ) , I— 10 , 16)/' 2 ' , ' 5 ' , ' 10' , ' 20' , ’ 50' , ' 100 • , ' 200 '/ 

225  DATA  (Pstr(9, I) , 1-12, 15)/’ 10' , '20' , '50' , ' 100'/ 

226  DATA  (Pst r( 10, I ) , 1-1 , 5)/' -1 .9  TO  0.6’, '-2.0  TO  0.5', 

227  &' -2.1  TO  0.4* ,'-2.2  TO  0.3' .'-2.3  TO  0.2'/ 

228  DATA  (Pst r (11, I) , I— 1 , 16)/'+/-0 . 01 ' , '+/-0.02' , '+/-0.05* , '+/-0.1 ' 

229  &'+/-0.2' , '+/- 0.5' ,'+/-!• O' .'+/-2.0' , '+/-5-0' , '+/-10' f '+/-20' , 

230  &'+/-50' , '+/-100' , '+/-200' , '+/-500' , '+/-1000'/ 

231  DATA  (Pstr(12, I) , 1-1 , 16)/'+/-0 .01 • , '+/-0.02' t '+/-0.05' ,'+/-0.\ ' 

232  &’+/-0.2' , ' +/-0.5' , '+/-!• O' , '+/-2.0' , ' +/-5.0' , '+/-10' , '+/-20' , 

233  &'+/-50* , '+/-100' , '+/-200* , '+/-500' , '+/-1000'/ 

234  DATA  (Pst r( 13 , I ) , 1-1 , 8)/' +/-0 .01 • .'+/-0.02' ,'+/-0.05’ ,’+/-0.r , 

235  &'+/-0.2' , ' +/-0 . 5 ' ,'+/-!  O' , '+/-2.0'/ 

236  DATA  (Pstr(14, 1) , 1-1,10)/' O' , • 10' , ' 20' , ’ 30' , ' 40'  , ' 50' , ' 60 '  ,  '  70 ' 

237  &'80','90'/ 

238  DATA  (Pst r(15 , 1 ) , 1-1 , 4)/’ 0. 5 ■ , • 1 . O' , ' 3 .  O'  ,  ’  10 •  / 

239  DATA  (Pstr(16, I) , 1-1 ,2)/'NORMAL' , 'REVERSE'/ 

240  DATA  (Pstr(17 , I ) , 1-1 ,2)/' OFF’ , 'ON'/ 

241  DATA  (Pstr(18, I) , 1-1 ,2)/'REPEAT  SCAN' , ' SCL/MULTI ' / 

242  DATA  (Pstr(19, I) , 1-1 ,2)/’SERIAL' , 'OVERLAY'/ 

243  DATA  (Pstr(20, I) , 1-1 ,4)/'BOTH  ON' , 'UV  ONLY' , 'VIS/NIR  ONLY' , 

244  &' BOTH  OFF'/ 

245  DATA  (Pstr(21 , I) , 1-1 ,3)/'AUTO' , 'UV' , 'VIS/NIR'/ 

246  DATA  (Pstr(22, I ), 1-1 ,3)/' AUTO’ ,' UV' , 'VIS/NIR' / 

247  DATA  (Pst r(23 , 1 ) , I-l , ? ' /' FULL’ , ' 1/3 ’ / 

248  DATA  (Pst r (24 , I ) , I-l , 3)/' AUTO’ , ' UV/VIS ' , ' NIR’ / 

249  DATA  (Pst r (25 , I ) , I-l , 3)/’ AUTO’ , ’ UV’ , ' VI S/NIR' / 

250  DATA  (Pstr(26, I) , I-l ,4)/'AUTO  SELECT’ , 'AUTO  GAIN’ , 'AUTO  SLIT’, 

251  &' SINGLE  BEAM'/ 

252  DATA  (Pstr(27, I) , I-l ,2)/'FULL’ , ' 1/3'/ 

253  DATA  (Pst r (28 , l ) , I-l , 6)/' O' , ' l ’ , ' 2' , ’ 3 ' , ' 4 ' , ' 5 ' / 

254  DATA  (Pstr(29 , I ), I-l , 2)/' STANDARDS ',' UNKNOWNS ’ / 

255  DATA  (Pst r (30 , I ), 1-3 , 6)/' DIRECT’ ,' LINEAR' ,' DIRECT-QUAD’ , 

256  &' QUADRATIC'/ 

257  DATA  (Pst r (31 , I ), 1-7 , 8)/ ' NORMAL' ,' AVERAGED' / 

258  DATA  (Pst r (32 , I ), 1-9 , 13)/' S IGNAL  AV’ ,’ SAMPLE  AV’ ,' QUICK’ , 

259  &' EXTENDED' , 'FIXED'/ 

260  DATA  (Pst r (33 , 1 ) , I-l , 5)/' DSPL  RESULTS ',' DSPL  SETUP', 'NEXT  CONC' 

261  &’ DELETE  SAMPLE' , 'CLEAR  RESULTS'/ 

262  DATA  (Pst r (34 , I ) , I-l , 2)/' OFF’ , ’ ON' / 

263  DATA  (Pstr(35, I) , I-l ,2)/' 1 ' , ' 2'/ 

264  DATA  (Pstr(38, I) , I-l ,5)/’  OFF','  ON ',' RECORD' , '  ON/SETUP' / 

265  DATA  (Pst r (40 , I ) , l-l , 2)/’ INTERVAL’ , ' ACCY-DRIVEN' / 


DATA  (Fit(I), 1-1,5)/'  7' , ' 11 • . *  15' , ' 21 ' , ' 25' / 


Pfit-'  POINT  FIT' 

BELL-CHAR ( 7 )  ■ 

ESC-CHAR ( 27 ) 

CLR-ESC//' J' 

HOME-ESC//' h' 

UP— ESC//' A' 

DOWN— ESC// ' B ' 

ERASE— ESC//' K'  I 


Assign  Statement  Labels 


ASSICN  10  TO  MENU 
ASSIGN  100  TO  READ 
ASSIGN  300  TO  SETTINGS 
ASSIGN  400  TO  EDIT 
ASSIGN  1000  TO  STORE 
ASSICN  2000  TO  CURFILE 
ASSIGN  9999  TO  EXIT 


Data  Transfer  And  Edit  Control  Menu 


CALL  FFRCL(79)  !  Eliminate  Line  Wrap 

10  WRITE  (1,*)  HOME , CLR , '_' 

NCOL-70 

TITLE-' Cary  2390' 

CALL  Center (TITLE) 

TITLE-' Spectral  Data  Editing’ 

CALL  Center (TITLE) 

WRITE  (1 , ' (T61 ,A2,A8) ' )  UP, 'Rev:  1.8' 

CALL  Line(NCOL) 

WRITE  (1,20)  'CODE' , 'FUNCTION' , 'STATUS' , 'MIN' , 'MAX' ,' INC' 
20  FORMAT  (T4 , A4 , T1 8 , A8 ,T38 , A7 , T50 , A3 , T58 , A3 , T66 , A3 ) 

CALL  Line(NCOL) 

WRITE  (1,30)  'R',' . Read  Spectrum . *,Sstat(l) 

&Smin, Smax , S inc 

WRITE  (1,40)  'I',' . Instrument  Settings . ’,Sname(l) 

WRITE  (1,30)  'E',' . Edit  Spectrum . '.Fname, 

&Emin, Emax, Einc 

WRITE  (1,50)  'S',' . Store  Spectrum . ’,Fstat 

WRITE  (1,50)  ’D',’ . Store  Derivative . '  ,Dstat 

WRITE  (1,50)  'C',' . Store  Curve  Fit  Fi 1 e Cstat 

WRITE  (1,60)  'X',' . EXIT  Menu . ’ 


319 

320 

321 

322 

323 

324 

325 

326 

327 
323 

329 

330 

331 

332 

333 

334 

335 

336 

337 

338 

339 

340  C 

341  C 
.342  C 

343  C 

344  C 

345  C 

346  C 

347 

348 

349 

350 

351 

352 

353 

354 

355 

356 

357 

358 

359 

360 

361 

362 

363 

364 

365 

366 

367 

368 

369 

370 


30 

40 

50 

60 


70 


80 

90 


FORMAT  (/,T6,A,T7,A30,T39,A10,T50,A4,T58,A4,T66,A4) 
FORMAT  (/ , T6 , A , T7 , A30 , T39 , A20 ) 

FORMAT  (/ , T6 , A , T7 , A30 , T39 , Al 0) 

FORMAT  (/,T6,A,T7,A30) 

WRITE  (l,*) 

CALL  Line(NCOL) 

WRITE  (1,*) 

WRITE  (1,*)  UP, ERASE, 

WRITE  (1 , ' (T3,A15,A,A2) * )  'Enter  the  CODE: ', BELL, '  ' 
READ  (1,80)  Code 


CALL  Upper (Code) 
IF  (Code .EQ. 'R' ) 
IF  (Code.EQ. ’ 1 1 ) 
IF  (Code.EQ. ’E’ ) 
IF  (Code.EQ. ’S' ) 
IF  (Code.EQ. 'D') 
IF  (Code.EQ. 'C' ) 
IF  (Code.EQ. 'X' ) 
CO  TO  70 
FORMAT  (Al) 
FORMAT  (A14) 


CO  TO  READ 
GO  TO  SETTINGS 
GO  TO  EDIT 
GO  TO  STORE 
CO  TO  STORE 
GO  TO  CURFILE 
CO  TO  EXIT 


Read  Spectrum 


100  TITLE-' Read  Spectrum' 

J-l 

IF  (Sstat(I) .NE. 'VALID')  GO  TO  120 
110  WRITE  (1,*)  UP, ERASE,'  Spectrum  is  PRESENT:  ', 

&'N...New  Spectrum,  B. . . Base  1 ine ,  Q...Quit  ?  ',BELL,'_' 

READ  (1,80)  I code 
CALL  Upper (I code) 

IF  (Icode.EQ. 'Q')  CO  TO  70 
IF  (Icode.EQ. 'N' )  CO  TO  120 
IF  (Icode.NE. 'B' )  GO  TO  110 
IF  (Sstat(2) .EQ. 'VALID' )  THEN 
WRITE  (1,*)  UP, ERASE,'  Baseline  SUBTRACTED:  ' , BELL 
CALL  Wait  (2.0) 

GO  TO  110 
END  IF 

TITLE— ' Subt ract  Baseline' 

J-2 

120  WRITE  (1,*)  HOME.CLR, 

CALL  Center (TITLE) 

CALL  Li ne(NCOL) 

WRITE  (1,*)  DOWN,'  Enter  Filename:  ',BELL,'_' 

READ  ( 1 , ' (A20) ' )  Sname(J) 

WRITE  (1,*)  DOWN,'  Directory,  (RETURN  -  /DEFAULT/):  '.BELL, 
READ  (1,'(A40)’)  Directory 


32 


371  IF  (Directory. EQ. '  ' )  THEN 

372  Fi lespec-Sname( J) 

373  GO  TO  130 

374  END  IF 

375  K— 40 

376  DO  WHILE  (Di rectory(K:K) .EQ. '  ’) 

377  K-K-l 

378  END  DO 

379  Fi lespec-Di rectory(l :K) // '  /  ' //Sname ( J) 

380  130  K-63 

381  DO  WHILE  (Fi lespec(K:K) . EQ. ’  ') 

382  K-K-l 

383  END  DO 

384  WRITE  (1,*)  UP, ERASE,'  Validating:  ' ,Filespec(l :K) , ' 

385  CALL  Wait (1.0) 

386  OPEN  (UNIT-66, FILE-Fi lespec(lrK) , I OSTAT-N , STATUS-’ OLD' ) 

387  WRITE  (1,*) 

388  IF  (N.NE.0)  THEN 

389  N-N-500 

390  WRITE  (1,*)  UP , ERASE, ' 

391  IF  (N.EQ.6)  WRITE  (1,*T  *  File  does  NOT  EXIST:  ' , BELL, ' 

392  IF  (N.EQ.8)  WRITE  (1,*)  '  File  is  already  OPEN:  ’ , BELL , ' _ 1 

393  IF  ( (N.NE.6) .AND. (N.NE. 8) )  WRITE  (1,*)  ’  Disk  Error  #  1 ,N, 

394  &  BELL, 

395  CALL  Wait (2.0) 

396  WRITE  (1,*) 

397  IF  (J.EQ.l)  Sstat(J)-' INVALID' 

398  GO  TO  MENU 

399  END  IF 

400  Fname— '  '  !  New  File  Opened  So  Erase  Any 

401  Emin-'  *  !  Previous  Descriptors  For 

402  Emax-'  '  *  !  A  Val id  Edited  Spectrum 

403  Einc-'  ' 

404  Sstat (2)-'  ' 

405  WRITE  (1,*)  UP, ERASE,'  Reading  File:  ’ , Fi lespec( 1 : K) , BELL 

406  READ  (66 , FMT— 140 , I OSTAT-N , ERR-230)  LABEL ( J ) 

407  140  FORMAT  (A72) 

408  WRITE  (1,*)  DOWN,’  Title:  ’ 

409  WRITE  (1,*)  '  ’.LABEL(J) 

410  READ  (66, FMT-150, IOSTAT-N, ERR-230)  DATE ( J ) 

411  150  FORMAT  (A8) 

412  WRITE  (1,*)  DOWN,'  Date:  ' , DATE ( J ) 

413  READ  (66,*, I OSTAT-N, ERR-230)  XMIN(J) ,XMAX(J) ,XSTEP(J) ,CONC(J) , 

414  &PATH( J) 

415  READ  (66,*, I OSTAT-N, ERR-230)  ORD(J) , ABSC(J) ,CELL(J) ,CYCLE(J) , 

416  &SAMPLE(J) , WAVE ( J ) , TIMER( J ) , TEMP( J) ,DIST(J) 

417  WRITE  (1,160)  DOWN, ' Scan  Range :  ' ,XMAX(J) , '  to  ' ,XMIN(J) , 

418  &’  nm  at  '  ,XSTEP(J)  ,  '  run  steps' 

419  WRITE  (1, ’ (T4,A2,A12,2X,C9.4) ' )  DOWN, 'Cone.  (M)  :  \CONC(J) 

420  WRITE  (1,170)  DOWN, ’Path  (cm)  :  ’,PATH(J) 

421  WRITE  (1,170)  DOWN, 'Temp.  (C)  :  ' ,TEMP(J) 

422  160  FORMAT  (T4 , A2 , A12 , F6 . 2 , A4 , F6 . 2 , A7 , F4 . 2 , A9) 

423  170  FORMAT  (T4 , A2 , A12 , F6 . 2) 


< 


424 

425 

426 

427 

428 

429 

430 

431 

432 

433 

434 

435 

436 

437 

438 

439 

440 

441 

442 

443 

444 

445 

446 

447 

448 

449 

450 

451 

452 

453 

454 

455 

456 

457 

458 

459 

460  C 

461  C 

462  C 

463 

464 

465 

466 

467 

468 

469 

470 

471 

472 

473 

474 

475  C 

476  C 


READ  (66.FMT-180, IOSTAT-N , ERR-230)  NP,NV,ND(J) 

180  FORMAT  (13,13,16) 

IF  ((NP.NE.49) .OR. (NV.NE. 14))  GO  TO  220  !  Data  Format  Error 

WRITE  (1,*) 

IF  (ABS(XMIN(J)-WAVE(J)) .CT.0.2)  THEN  < 

WRITE  (1,*)  ’  Scan  ended  at ' ,WAVE(J) , '  nm'.BELL 
CALL  Wait (2.0) 

WRITE  (1,*)  UP, ERASE, UP, UP 
END  IF 

WRITE  (1 ,*)  HOME, 

TITLE-’###  READING  DATAFILE  ###’  j 

CALL  Center(TITLE) 

READ  (66, FMT-190, IOSTAT-N, ERR-230)  (PARAM(J ,K) ,K-1 ,NP) 

190  FORMAT  (12) 

READ  (66,*, IOSTAT-N, ERR-230)  (VARIABLES ,K) ,K-1 ,NV) 

NDATA-ND(l) 

IF  (J.EQ.l)  THEN 

READ  (66,*, IOSTAT-N, ERR-230)  (Y(I) , I— 1 ,NDATA) 

READ  (66,*, IOSTAT-N, ERR-230)  (X( I ) , I— 1 ,NDATA) 

WMIN-XMIN(J) 

WMAX-XMAX(J) 

STEP— XSTEP(J) 

CALL  Str(WMIN, String, 4) 

Smii*-String(2:5) 

CALL  Str(WMAX, String, 4) 

Smax-Str ing(2:5) 

CALL  Str(STEP, String, 4) 

Sinc-String(2:5) 

Sstat (J)—' VALID* 

IF  (PARAM( 1 , 1 ) . EQ. 0)  THEN 

Ymode-'A'  !  Ordinate  Mode  -  ABSORBANCE 

ELSE 

Ymode-'T'  !  Ordinate  Mode  -  TRANSMISSION 

END  IF 

GO  TO  210  !  Close  Spectrum  File 

END  IF 


Test  For  Baseline  Matching 


MATCH-. TRUE. 

IF  (XMIN(l) ,LT.XMIN(2))  MATCH- . FALS E . 

IF  (XMAX(l) ,CT.XMAX(2))  MATCH-. FALSE. 

IF  (XSTEP(l) .NE.XSTEP(2) )  MATCH- . FALSE . 

IF  (PARAM( 1 , 1 ) .NE. PARAM(2 , 1 ) )  MATCH-. FALSE. 

IF  (PARAM( 1 , 5) .NE. PARAM(2 , 5) )  MATCH-. FALSE. 

IF  (PARAM( 1,16) .NE. PARAM(2 , 16) )  MATCH-. FALSE. 
IF  (PARAM(1 , 21 ) .NE. PARAM(2 , 21 ) )  MATCH-. FALSE. 
IF  (PARAM(1 ,22) .NE. PARAM(2 , 22) )  MATCH-. FALSE. 
IF  (PARAM(1 ,23) .NE. PARAM(2 , 23) )  MATCH-. FALSE. 
IF  (PARAM( 1 , 38) .NE. PARAM(2 , 38) )  MATCH-. FALSE. 
IF  (.NOT. MATCH)  GO  TO  240 


Read  Entire  Baseline  File 


34 


READ  (66,*, IOSTAT-N.ERR-230)  (YB( I ) ,  I-1,ND(2)) 
READ  (66,*, IOSTAT-N.ERR-230)  (XB(I),  I-1,ND(2)) 


477  C 

478 

479 

480  C 

481  C 

482  C 

483 

484 

485 

486 

487 

488 

489 

490 

491 

492 

493 

494 

200 

495 

496 

210 

497 

498 

499 

500  C 

501 

220 

502 

503 

504 

230 

505 

506 

507 

240 

508 

250 

509 

510 

511 

260 

512 

513 

514 

515  C 

516  C 

517  C 

518  C 

519  C 

520  C 

521  C 

522 

300 

503 

524 

525 

526 

527 

528 

529 

Match  Baseline  Index  To  Starting  Wavelength  Of  Spectrum 


START-0 

IF  (WMAX.LT.XMAX(2) )  THEN 

START-N1NT( (XMAX(2) -WMAX) /XSTEP(2) ) 
END  IF 


DO  200  I-l.NDATA  ! 

K-I+START  ! 

IF  (Ymode.EQ. ’A’ )  THEN  ! 

Y(  I  )— Y (  I  )  -YB(K)  ! 

ELSE  ! 

Y(l)-(Y(I)/YB(K))*100.0  ! 

END  IF  ! 

CONTINUE  ! 

Sstat (J)—' VALID'  ! 

CLOSE  (UNIT-66 , IOSTAT-N , ERR-230) 
COUNT-0  ! 

J-l  ! 

GO  TO  MENU  • 


Subtract  Relevant  Wavelength 
Region  Of  Baseline  File 
Absorbance  Mode 

SUBTRACT  BASELINE  DATA 
Transmission  Mode 

RATIO  TO  BASELINE  DATA 
NB:  You  Can't  READ  &  SUBTRACT 
With  The  Implied  DO  LOOP  FORM 
Set  Baseline  To  VALID 

Zero  Smoothing  Cycle  Counter 
Select  Spectrum  Mode  Before 
Returning  To  Main  Menu 


WRITE  (1,*)  UP, ERASE,'  Data  Format  Error:  ',BELL,'_' 

Sstat (J)-' ABORTED' 

GO  TO  250 

WRITE  (1,*)  UP, ERASE,'  Disk  Error  # ' , N , BELL , '  _' 

Sstat (J)-' INVALID' 

GO  TO  250 

WRITE  (1,*)  UP, ERASE,'  Baseline  Mismatch  Error:  ’,BELL,'_' 
CALL  Wait (2.0) 

WRITE  (1,*) 

GO  TO  210 

WRITE  (1,*)  UP, ERASE,’  Spectrum  is  ABSENT:  \BELL,’_’ 

CALL  Wait (2.0) 

WRITE  (1,*) 

GO  TO  70 


Display  Instrument  Settings 


IF  (Sstat(l).NE. ’VALID’ )  CO  TO  260 
IF  (Sstat (2) .EQ. ’VALID’ )  THEN 

WRITE  (1,*)  UP, ERASE,’  S... Spectrum  or  B... Baseline  ?  ’ 
&  BELL, ’_’ 

READ  (1,80)  Icode 
CALL  Upper (Icode) 

J-l 

IF  ( Icode. EQ. ’B’ )  J-2 


1 


530  END  IF 

531  BAND- VARIABLES,  10) 

532  CAIN— VAR I ABLE (J ,6) 

533  CALL  Val (Pst r (7 , PARAM( J , 7)+l ) , PMAX) 

534  PMIN-VARIABLE( J , 1 ) 

535  IF  (PARAM(J.l).NE.O)  THEN 

536  CALL  Val(Pstr(8,PARAM(J,8)+l) , PMAX) 

537  PM I N-VAR I ABLE ( J , 1 1 ) 

538  END  IF 

539  PMAX— PM I N+PMAX 

540  K-ll 

541  IF  (PARAM( J ,6) . EQ. 4)  K-10 

542  St  ring— Pst r (K, PARAM( J , K)+l ) 

543  WRITE  (1,*)  HOME , CLR , ' _ ' 

544  TITLE-' I  ns  triune  nt  Settings' 

545  CALL  Center(TITLE) 

546  CALL  Line(50) 

547  WRITE  (1 , ' (T20,A8,T40,A7) ' )  'FUNCTION 

548  CALL  LINE(50) 

549  WRITE  (1,*) 

550  WRITE  (1,320)  'WAVELENGTH  LIMITS . 

551  &XMIN(J) , ' , ' ,XMAX(J) 

552  WRITE  (1,330)  'ORDINATE . 

553  &Pst r (1 , PARAM( J , 1 )+l ) 

554  WRITE  (1,330)  'ABSCISSA . 

555  &Pstr(2,PARAM(J,2)+l) 

556  WRITE  (1,330)  'SCAN  RATE  (nm/sec) _ 

557  &Pstr(3,PARAM(J,3)+l) 

558  WRITE  (1,330)  'CHART  DISPLAY  (nm/cm) . 

559  &Pstr(4,PARAM(J,4)+l) 

560  WRITE  (1,330)  'REFERENCE  MODE . 

561  &Pst  r (5 , PARAM( J , 5)+l ) 

562  WRITE  (1,340)  ' SBW  (nm) ,  CAIN . 

563  &BAND, ' , ' .GAIN 

564  WRIT“  (1,330)  'PEN  FUNCTION . 

565  &Pst  r (6 , PARAM( J , 6)+l ) 

566  WRITE  (1,340)  'PEN  LIMITS  (Min.Max).. 

567  &PMIN, ' , ' ,PMAX 

568  IF  (PARAM( J , 6) . GT . 1 )  WRITE  (1,350)  UP, 

569  WRITE  (1,330)  'RESPONSE  TIME  (sec).... 

570  &Pst r  ( 15 , PARAM( J , 15)+1 ) 

571  WRITE  (1,330)  'BEAM  INTERCHANGE . 

572  &Pstr ( 16 , PARAM( J , 16)+1 ) 

573  WRITE  (1,330)  'SLIT  HEICHT . 

574  &Pst  r (23 , PARAM( J , 23)+l ) 

575  WRITE  (1,330)  'LAMP  SELECT . 

576  &Pstr(?1 , PARAM( J , 21 )+l ) 

577  WRITE  (1,330)  'DETECTOR  SELECT . 

578  &Pstr(22,PARAM(J ,22)+l) 

579  320  FORMAT  (T15 , A23 , T40 , F5 . 2 , A, F5 . 2) 

580  330  FORMAT  (T15 , A23 ,T40 , A14) 

581  340  FORMAT  (T15 , A23 , T40 , F4 . 2 , A , F5 . 2) 

582  350  FORMAT  (T40 , A2 , A2 , A14) 


'  SETTING' 


ERASE, String 
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WRITE  (1,*) 

CALL  Line(50) 

WRITE  (1,*) 

360  WRITE  (1 , 1 (T14,A2,A2,A23,A,A) 1 )  UP.ERASE, 
&'  Press  RETURN  for  MENU:  ',BELL,'_' 

READ  (1,80)  I code 
CALL  Upper (I code) 

IF  (Icode.NE. '  ')  CO  TO  360 
CO  TO  MENU 


Edit  Spectral  File  Parameters 


IF  (Sstat(l) .NE. 'VALID' )  CO  TO  260 
WRITE  (1,*)  HOME , CLR , '_' 
TITLE-'Edit  Spectral  Parameters' 
CALL  Cente r(TITLE) 

CALL  Line (40) 


WRITE  (1,*) 

WRITE  (1,410)  'C  . Concentration,  (M) 

WRITE  (1,410)  'D . Date,  (.W/DD/YY) 

WRITE  (1,410)  'L  . Label,  (72  chars) 

WRITE  (1,410)  'P  . Path length,  (cm) 

WRITE  (1,410)  'S  . Spectral  Data 

WRITE  (1,410)  'X . EXIT  to  Menu 

410  FORMAT  (T24.A25,/) 

CALL  Line(40) 

WRITE  (1,*) 

420  WRITE  (1,430)  UP.ERASE, 

430  FORMAT  (T19 , A2 , A2 , A) 

WRITE  <1 , ' (A17,A,A) ' )  '  Enter 
READ  (1,80)  Icode 
CALL  Uppe r ( I code ) 

IF  ( Icode. EQ. 'C' )  CO  TO  440 
IF  ( Icode. EQ. 'D' )  CO  TO  460 
IF  ( Icode. EQ. 'L' )  CC  TO  470 
IF  ( Icode. EQ. 'P' )  CO  TO  480 
IF  ( Icode. EQ. 'S' )  CO  TO  500 
IF  ( Icode. EQ. 'X' )  CO  TO  MENU 
CO  TO  420 


Enter  the  CODE: 


440  WRITE  (1,430)  UP.ERASE, 

WRITE  (1,*)  'Concentrat ion, (M) : 
WRITE  (1,450)  UP, BELL 
450  FORMAT  (T39,A2,A,'?  _' ) 

READ  (1,90)  String 
IF  (String. EQ. '  ' )  CO  TO  420 
CALL  Val (String, CONC(l)) 

CONC ( 1 ) — ABS ( CONC ( 1 ) ) 

CO  TO  420 


' , CONC( 1 ) 


460  WRITE  (1,430)  UP,ERASE,'_' 

WRITE  (1,*)  'Date,  (NW/DD/YY)  :  ' , DATE( 1 ) 

WRITE  (1,450)  UP, BELL 
READ  (1,150)  String 
IF  (String. EQ. '  ')  GO  TO  420 
DATE(1)-String(l :8) 

GO  TO  420 


470  WRITE  (1,*)  UP, ERASE, 'Label :* .DOWN 
WRITE  (1,' (A3, A72)')  ’  ' ,LABEL(1) 

WRITE  (1 , ' (T4,A,T75 ,A) ' )  't’.’T' 

WRITE  (1,*)  UP, UP, BELL, '? 

READ  (1,140)  TITLE 

WRITE  (1,*)  ERASE, UP, ERASE, UP, UP, ERASE 
IF  (TITLE. EQ.’  ' )  GO  TO  420 
LABEL(l) -TITLE 
GO  TO  420 


480  WRITE  (1,430)  UP, ERASE, '_' 

WRITE  (1,490)  '  Path  length,  (cm):  \PATH(1) 

490  FORMAT  (X,A20,X,F5.4) 

WRITE  (1,450)  UP, BELL 
READ  (1,90)  String 
IF  (String. EQ.'  ')  CO  TO  420 
CALL  Val (String, PATH(l)) 

PATH( 1 )— ABS (PATH( 1 ) ) 

CO  TO  420 


664  C 

665 

500 

TITLE-’ Edit  Spectral 

Data' 

666 

WRITE  (1,*)  HOME , CLR , 

•  1 

667 

CALL  Center(TITLE) 

668 

CALL  Line(40) 

669 

WRITE  (1,*) 

670 

WRITE  (1,510)  'L  . . . . 

.List  Data  S.  0ment ’ 

671 

WRITE  (1,510)  'E  _ 

.Edit  Single  Datum' 

672 

WRITE  (1,510)  'O  _ 

.Offset  Segment  ' 

673 

WRITE  (1,510)  'N  _ 

.Near  IR  Rescale  ' 

674 

WRITE  (1,510)  'R  _ 

.Reduce  File  Size  ' 

675 

WRITE  (1,510)  'S  _ 

.Smooth  Segment  ' 

676 

WRITE  (1,510)  'D  _ 

.Deriv.  Spectra  ' 

677 

WRITE  (1,510)  'X  _ 

.EXIT  Data  Editing' 

678 

510 

FORMAT  (T26,A24,/) 

679 

CALL  Line (40) 

680 

WRITE  (1,*) 

681 

520 

WRITE  (1,530)  UP, ERASE, '_' 

682 

530 

FORMAT  (T19,A2,A2,A) 

683 

WRITE  (1,540)  '  Enter 

the  CODE:  ' , BELL , ' 

684 

540 

FORMAT  (A17 , A, A) 

685 

READ  (1,80)  Code 

686 

CALL  Upper (Code) 

687 

WRITE  (1,*)  UP, ERASE, UP 

636  C 

637 

638 

639 

640 

641 

642 

643 

644  C 

645 

646 

647 

648 

649 

650 

651 

652 

653 

654  C 

655 

656 

657 

658 

659 

660 
661 
662 
663 


38 


I 

688 

689 

690 

691 

692 

693 

694 

695 

696 

697 

698 

699 

700 

701 

702 

703 

704 

705 

706 

707  C 

708  550  WRITE  (1,*)  '  Scan  Range:  \WMIN,’  to' ,WMAX, '  nm  at ' , 

709  &STEP , '  nm  steps' .DOWN, DOWN 

710  560  WRITE  (1,*)  UP, ERASE,'  DISPLAY  Range:  (MIN, MAX)  ?  ',BELL,'_'  * 

711  READ  (1 , *,ERR— 560)  WN.WX 

712  WN-ABS(WN) 

713  WX-ABS(WX) 

714  CALL  XI imits (WN.WX) 

715  IF  ( (WN. LT. WMIN) .OR. (WN.CT . WMAX) )  CO  TO  560 

716  IF  <(WX.LT. WMIN) .OR. (WX.GT.WMAX) )  CO  TO  560  •  • 

717  START— NINT ( (WMAX-WX)/STEP)+1 

718  FINI SH— NINT (NDATA-(WN-WMIN)/STEP) 

719  IF  (Ymode.EQ. 'A' )  THEN 

720  TITLE-' Wavelength  Absorbance  Ext.Coeff.  (/M/cm)' 

721  ELSE 

722  TITLE-' Wave  length  %  Transmission' 

723  END  IF 

724  WRITE  (1,*)  HOME , CLR , ' _ ' 

725  CALL  Center (TITLE) 

726  CALL  Line (50) 

727  L— 1 

728  DO  580  I-START, FINISH 

729  WL—( WMAX- FLOAT ( I -1 ) *STEP)  !  Calculated  Wavelength 

730  EC— Y ( I ) /CONC ( l ) /PATH ( 1 )  !  Ext inct ion  Coefficient 

731  WRITE  (1,*) 

732  IF  (Ymode.EQ. 'A' )  THEN 

733  WRITE  (1,590)  X(I),Y(l),EC 

734  ELSE 

735  WRITE  (1,600)  X(I),Y(I) 

736  END  IF 

737  L-L+l 

738  IF  (L.EQ.10)  THEN 

739  WRITE  (1,*)  DOWN 

740  570  WRITE  (1,610)  UP, ERASE, ' Press  RETURN  to  Continue  ',BELL,'_' 


IF  (Code .EQ. ' L' ) 
IF  (Code.EQ. 'E' ) 
IF  (Code.EQ. ’O') 
IF  (Code.EQ. 'N' ) 
IF  (Code.EQ. 'R* ) 
IF  (Code.EQ. 'S’ ) 
IF  (Code.EQ. 'D') 
IF  (Code .NE. ’X’ ) 
WRITE  (1,*) 

CO  TO  520 
END  IF 

CALL  Str(WMIN,St 
Emin-String(2:5) 
CALL  St r (WMAX, St 
Emax-S t r I ng(2 : 5 ) 
CALL  Str(STEP, St 
Einc-String(2:5) 
Fname-’ VALID’ 

CO  TO  400 


CO  TO  550 
CO  TO  630 
CO  TO  660 
CO  TO  660 
GO  TO  660 
GO  TO  740 
CO  TO  740 
THEN 


ring, 4) 
ring, 4) 
ring, 4) 
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741 

742 

743 

744 

745 

746 

747 

748 

749 

750 

751 

752 

753 

754 

755 

756 

757 

758 

759 

760 

761 

762 

763 

764 

765 

766 

767 

768 

769 

770 

771 

772 

773 

774 

775 

776 

777 

778 

779 

780 

781 

782 

783 

784 

785 

786 

787 

788 

789 

790 

791 

792 


READ  (1,80)  Icode 
CALL  Uppe  r ( I code ) 

IF  ( Icode. NE.’  ' )  CO  TO  570 
WRITE  (1,*)  HOME.CLR, 

CALL  Center (TITLE) 

CALL  Line (50) 

L-l 

END  IF 
580  CONTINUE 

590  FORMAT  (T16, F7 . 2 ,T30, F7 , 4.T45 , CIO . 4) 

600  FORMAT  (T22 , F7 . 2 ,T41 , F7 . 2) 

610  FORMAT  (T15,A2,A2,A25,A,A) 

WRITE  (1,*)  DOWN 

620  WRITE  (1,610)  UP, ERASE, 'Press  RETURN  for  MENU  '.BELL,' 
READ  (1,80)  Icode 
CALL  Uppe  r ( I code ) 

IF  (Icode. NE.'  ’ )  CO  TO  620 
CO  TO  500 


630  WRITE  (1,*)  ’  Scan  Range:  '.WMIN,*  to'.WMAX,'  nm  at ' , 
&STEP, '  nm  steps' .DOWN, DOWN 

640  WRITE  (1,*)  UP, ERASE,'  EDIT  Wavelength:  ?  ',BELL,’_' 

READ  (1 ,*,ERR-640)  WL 
WL-ABS(WL) 

IF  ( (WL.LT. WMIN) .OR. (WL.GT. WMAX) )  GO  TO  640 
i-NINT( (WMAX-WL)/STEP)+1 

WRITE  (1,*)  UP, ERASE, UP, UP, ERASE, '  Wavelength:  ' ,X( I ) , ' 

WRITE  (1,*)  '(Expected:’ , (WMAX-FLOAT( I -1)*STEP),'  nm) ’ 

IF  (Ymode.EQ. 'A')  THEN 
St  ring-' ABSORBANCE:  _' 

ELSE 

String— '%  T  or  *  R:  _' 

END  IF 

WRITE  (1,'(T5,A2,A14)')  DOWN, String 
WRITE  (1,*)  Y( I ) 

650  WRITE  (1 , ' (T18,A2,A,A3) ' )  UP, BELL,'?  _' 

READ  (1,90)  String 
IF  (String. EQ. '  ' )  CO  TO  500 
CALL  Val (St ring, NUMBER) 

IF  (Ymode.EQ. 'A' )  THEN 

IF  ((NUMBER. LT. -0.5) .OR. (NUMBER. CT. 4. 5))  GO  TO  650 
ELSE 

IF  ((NUMBER. LT. 0.0) .OR. (NUMBER. GT. 200.0))  CO  TO  650 

END  IF 
Y(  I ) -NUMBER 
GO  TO  500 


660  WRITE  (1,*)  '  Scan  Range:  '.WMIN,'  to'.WMAX,'  nm  at', 
&STEP , '  nm  steps' .DOWN .DOWN 
St  ring-’ OFFSET' 

K-6 

IF  (Code . EQ. ' N’ )  CO  TO  700 


nm 
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793 

IF  (Code.EQ. ’R' )  THEN 

794 

String-' FILE' 

795 

K-4 

796 

END  IF 

797  670 

WRITE  (1,*)  UP, ERASE,  '  ',String(l 

:K) , ’  Range:  (MIN, MAX)  ?  ' , 

798  &BELL , 

799 

READ  ( 1 , *, ERR— 670)  WN,WX 

800 

WN-ABS(WN) 

801 

WX-ABS(WX) 

802 

CALL  XI imits(WN,WX) 

803 

IF  ((WN.LT.WMIN) .OR. (WN.GT.WMAX)) 

GO  TO  670 

804 

805 

806 

807 

808  C 

IF  ((WX.LT.WMIN) .OR. (WX.CT. WMAX) ) 
START-NINT( (WMAX-WX)/STEP)+1 
FINISH-NINT(NDATA-(WN-WMIN)/STEP) 
IS— 1 

CO  TO  670 

IF  (Code.EQ. ’O' )  GO  TO  700 

809 

810  680 

WRITE  (1,*)  UP, ERASE,’  STEP  Mult ipl ier:  ?  ' , IS 

811 

WRITE  (1 , ' (T24.A2.A.A) ' )  UP, BELL,' 

I 

812 

READ  (1,90)  String 

813 

IF  (String. NE. '  ' )  THEN 

814 

CALL  Vai (String, NUMBER) 

815 

I S-N I NT (NUMBER) 

816 

IF  ( IS .CE.NDATA)  GO  TO  680 

817 

END  IF 

818 

J-l 

819 

DO  690  I -START, FINISH, IS 

820 

X(J)-X(I) 

!  Reduced  File  Begins  At 

821 

Y(J)-Y( I ) 

!  INDEX-1  -  Old  File  Data 

822 

J-J+l 

!  Is  Written  Over 

823  690 

CONTINUE 

824 

WAVE-X( FINISH) 

!  Update  File  Parameters 

825 

826 

827 

828 

829 

830 

831 

832  C 

ABSC-WAVE 

NDATA— ( FINISH-START) /I S+l 
ND(1)-NDATA 

STEP-STEP* FLOAT (IS) 

WMAX— ANINT (X( 1 ) ) 
WMIN-ANINT(X(NDATA) ) 

GO  TO  500 

!  To  Match  Reduced  File 

YOFF-O . 0 

833  700 

834 

IF  (Code.EQ. 'O' )  THEN 

835 

String-' Absorbance ' 

836 

IF  (Ymode.EQ. 'T' )  THEN 

837 

String-"#  T  or  %  R’ 

838 

END  IF 

839 

GO  TO  710 

840 

END  IF 

841 

IF  ((PARAM(1 ,5) .NE.0) .OR. (WMIN.GE 

800.0) .OR. (WMAX. LE. 800.0))  THEN 

842 

WRITE  (1,*)  UP, ERASE,'  NIR/VIS 

Change  Not  Used:  ',BELL,'_' 

843 

CALL  Wai t (2 . 0) 

844  GO  TO  500 


846  String-'NIR  Region' 

847  START-1 

848  FINISH— NINT( (WMAX-800 . 0)/STEP)+l 

849  YOFF— Y(FINISH+1 )-Y (FINISH)  !  Offset  At  800  nm  Detector  Change 

850  710  WRITE  (1,720)  UP,ERASE,String(l : 10) , '  OFFSET:  ' ,YOFF 

851  720  FORMAT  (T4,A2,A2,A10,A11 ,F7 .4) 

852  WRITE  (1 , ' (T24,A2,A,A3) ' )  UP, BELL,'? 

853  READ  (1,90)  String 

854  IF  (String. NE. '  ')  THEN 

855  CALL  Val (String, YOFF) 

856  END  IF 

857  IF  (YOFF. EQ. 0.0)  CO  TO  500 

858  IF  (Code.EQ. 'N'  )  THEN 

859  Y2— Y(FINISH+1)  !  First  Datum  In  Visible  Region 

860  Yl— Y2-YOFF  !  Final  Datum  In  Near  IR  Region 

861  END  IF 

862  DO  730  I -START, FINISH 

863  IF  (Code.EQ. 'O' )  Y(I)-Y(I) +YOFF 

864  IF  (Code.EQ. 'N' )  Y( I )— Y( I )*Y2/Y1 

865  730  CONTINUE 

866  CO  TO  500 

867  C 

868  C  - - - 

869  C 

870  C  Smooth  Spectrum 

871  C 

872  C  - - - 

873  C 

874  740  TITLE-' Smooth  Spectium' 

875  DERI V-. FALSE. 

876  IF  (Code . EQ. ' D' )  CO  TO  880  !  Transfer  To  Derivative  Setup 

877  C  - - - 

878  750  WRITE  (1,*)  HOME,CLR,’_' 

879  CALL  Center (TITLE) 

880  CALL  Line(NCOL) 

881  WRITE  (1,*)  DOWN,'  Select  ALGOR I THM :', DOWN 

882  DO  760  1-1,5 

883  WRITE  (1,770)  I,' . ' ,Fi t ( I) ,Pf i t 

884  760  CONTINUE 

885  770  FORMAT  (T25 , II ,X, A5 ,X, A2 , A10 ,/) 

886  1-6 

887  WRITE  (1 , ' (T25, II ,X,A18) ' )  I,' .  EXIT  to  Menu' 

888  WRITE  (1,*)  DOWN 

889  780  WRITE  (1,790)  UP, ERASE, ' Enter  the  CODE  #  :  ’,BELL,'_' 

890  790  FORMAT  (T5,A2,A2,A20,A,A) 

891  READ  (1,80)  Icode 

892  L-ICHAR( Icode) -48 

893  IF  ((L.LT. 1) .OR. (L.CT.6))  CO  TO  780 

894  IF  (L.EQ.6)  GO  TO  500 

895  WRITE  (1,*)  UP, ERASE, UP, UP, ERASE, UP, UP, ERASE, UP, UP, ERASE, UP, UP, 

896  &ERASE, UP, UP, ERASE, UP, UP, ERASE, UP, UP, ERASE 

897  WRITE  (1,*)  UP,'  ALCORITHM:  ' , Fi t (L) , Pf i t , ’  (Quart ic)' 


Step  Multiple  Defaults  To  2  For  Improved  Smoothing: 


898  C 

899  C 

900  C 

901  C 

902  C  -  The  Smoothing  Routine  Increments  1  Datum  Per  Fit. 

903  C  -  If  The  Noise  Is  Non-Random,  Increasing  The  Step  Size  May 

904  C  Produce  A  Sinusoidal  Approximation,  Which  Creates  Very 

905  C  Poor  Second  Derivative  Spectra.  Smooth  Those  Regions  With 

906  C  A  Large  Step  Size  To  Average  The  Noise  And  Then  With  The 

907  C  Step  Size  Reduced  To  1  Datum  To  Eliminate  Any  Ripples. 

908  C  -  In  General,  Higher  Multiples  Of  The  Data  Step  Size  Produce 

909  C  Better  Smoothing  &  MUCH  BETTER  Derivatives. 

910  C 

911  c  - - - 

912  IS-2 

913  RANGE-FLOAT (NPTS ( L) - 1 ) *STEP* FLOAT (IS) 

914  WRITE  (1,*)  DOWN,'  Default  SEGMENT  S ize .RANGE, '  run’ 

915  WRITE  (1,*)  DOWN 

916  WRITE  (1,*)  UP, ERASE, 

917  WRITE  (1,’(X,A20, II)')  '  STEP  Mul t ipl ier :  '.IS 

918  WRITE  (1 , ’ (T21 ,A2,A,A3) ' )  UP, BELL,'?  _' 

919  READ  (1,90)  String 

920  IF  (String. EQ. '  ' )  GO  TO  800 

921  CALL  Val (St ring, NUMBER) 

922  I S-N I NT (NUMBER) 

923  IF  (IS.LT.l)  IS— 1 

924  ITEST— (NDATA-1 )/(NPTS(L) -1 ) 

925  IF  (IS. GT. ITEST)  IS-ITEST 

926  800  RANGE— FLOAT (NPTS (L) -1 )*STEP*FLOAT (IS) 

927  WRITE  (1,*) 

928  &RANCE, ’  nm' 

929  C 

930  C  - - 

931  C 

I  932  C 

933  C 

934  C 

935  C 

936  C 

937  C  X- INDEX: 

•  938  C 

939  C 

940  C  OFFSETS : 

941  C 

942  C 

943  C  X-STEPS : 

I  944  C 

945  C 

946  C 

947  C 

948  C 

949  C 

1  950  C 


, ERASE, UP, UP, ERASE, '  Fitted  SEGMENT  Size:', 


LEAST  SQUARES  SMOOTHING 
OF  DATA  SEGMENT 

QUART I C  POLYNOMIAL  FITS 

-XX, . . . ,0, . . . ,+XX  Allows  For  Simplification  Of 
Least  Squares  Summations  -  Odd  Powers  -  Zero 

The  Algorithm  Can  NOT  Smooth  The  First  Or  Last 
(XX*IS)  Number  Of  Points  In  The  Spectrum 

The  Effectiveness  Of  The  Smoothing  Can  Be  Improved 
By  Widening  The  Wavelength  Interval  Used  By  The 
Routine  (Range  -  IS*XX*STEP  nm) ,  Reducing  The 
Spectral  Resolution.  The  User  Must  Judge  Which 
Algorithm  &  Step  Multiplier  (IS)  Is  Best  Suited 
For  The  Particular  Spectrum.  The  Minimum  Step 
Size  Is  1  Datum.  This  Is  Adequate  For  Smoothing 
But  NOT  For  Derivative  Spectra. 


951  C 

952  C 

953  C 

954 

955 

956  C 

957 

958 

959 

960 

961  C 

962 

963 

964 

965 

966 

967 

968 

969 

970 

971 

972 

973 

974 

975 

976  C 

977 

978 

979 

980 

981 

982 

983 

984 

I  985 

986 

987 

988 

989 

990 

►  991  C 

992  C 

993  C 

994 

995 

996 

►  997 

998 

999 
1000 
1001 
1002 

►  1003 


WOFF-STEP*FLOAT(IS*(NPTS(L)-l)/2)  !  Wavelength  Offset 

XOFF-(NPTS(L)+l)/2  !  X-Index  Offset+1 


WRITE  (1,*)  DOWN,'  Scan  Range:  \WMIN,'  to'.WMAX, '  nm  at ' , 
&STEP, '  nm  steps' 

WRITE  (1,*)  DOWN 

IF  (DERIV)  CO  TO  910  !  Re-enter  Derivative  Routine 


810  WRITE  (1,*)  UP, ERASE,'  SMOOTHING  Range:  (MIN, MAX)  ' ,BELL,’_' 
READ  (1 ,*, ERR-810)  WN.WX 
WN-ABS(WN) 

WX-ABS(WX) 

CALL  XI imits(WN.WX) 

IF  (WN.LT.WMIN+WOFF)  WN-WMIN+WOFF 
IF  (WX.CT. WMAX-WOFF)  WX-WMAX-WOFF 
START-NINT ( (WMAX-WX)/STEP)+1 
F I N I SH-N I NT (NDATA- ( WN-WM I N ) /STEP ) 

WRITE  (1,*)  UP, ERASE,'  SMOOTHING  Range:  ',WN,'  to'.WX,'  nm' , 
&DOWN.DOWN 

820  WRITE  (1,*)  UP, ERASE,'  Total  #  of  Smoothing  PASSES:  ' , BELL , '  ' 
READ  (1 ,*,ERR— 820)  NPASS 
IF  (NPASS.LT. 1)  CO  TO  820 


830 


840 


WRITE  (1,*)  DOWN 
DO  870  N-l, NPASS 

WRITE  (1,*)  UP, ERASE,'  Pass  #' ,N, ’ 
DO  850  I -START, FINISH 
DO  830  J-1,5 

SS(J)-0.0  ! 

CONTINUE 

DO  840  K— 1 ,NPTS(L) 

XX-K-XOFF  ! 

YY— DBLE(Y( I+XX*IS) )  ! 

SS ( 1 )— SS ( 1 )+YY  ! 

SS(3)-SS(3)+YY*DBLE(XX**2)  ! 

SS(5)-SS(5)  YY*DBLE(XX**4)  ! 

CONTINUE 


in  PROGRESS: ’ , BELL 


Zero  Summations  Array 


Segment  Is  (-XX.+XX): 
Step  Size  Is  IS*STEP 
Calculate  Summations 
For  Least  Squares  Fit 
Within  Segment : 


Array  CC  Holds  Known  Least  Squares  Coefficients 


YY-CC(L,1)*SS(1)+CC(L,3)*SS(3)+CC(L,5)*SS(5) 

Z( I )— SNGL(YY)  !  Z( I )  Is  Smoothed  Segment 

850  CONTINUE  !  For  Range  Requested  Only 

DO  860  l -START, FIT"  SH 

Y( I )-Z( I )  !  Update  Y(I)  With  Z( I ) 

860  CONTINUE 

COUNT— COUNT+1  !  Update  Total  #  Of  Passes 

870  CONTINUE 

WRITE  (1,*)  UP, ERASE,'  Smoothing  FINISHED:  ',BELL,'_' 

CALL  Wait (2.0) 
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1004 

1005 

1006 

1007  C 

1008  C 

1009  C 

1010  C 

1011  C 

1012  C 

1013  C 

1014 

1015 

1016 

1017 

1018 

1019 

1020 
1021 
1022 

1023 

1024 

1025 

1026 

1027 

1028 

1029  C 

1030  C 

1031  C 

1032 

1033 

1034 

1035  C 

1036  C 

1037  C 

1038 

1039 

1040 

1041 

1042 

1043 

1044 

1045 

1046 

1047 

1048 

1049 

1050 

1051 

1052 

1053 

1054 

1055 

1056  C 


Fstat-' SMOOTHED' 

IF  (Code.EQ. 'D' )  GO  TO  900 
GO  TO  500 


Derivative  Spectrum  Routine 


880  WRITE  (1,*)  HOME.CLR, 

TITLE— ' Deri vat ive  Spectrum' 

CALL  Center (TITLE) 

CALL  Line(NCOL) 

WRITE  (1,*)  DOWN 

890  WRITE  (1,*)  UP, ERASE, '  SMOOTH  Spectrum  First,  (Y  or  N)  ?  ' , 
&BELL, 

READ  (1,80)  Icode 
CALL  Upper (Icode) 

IF  ( Icode. EQ. 'Y' )  THEN 
DERI V-. FALSE. 

TITLE-' Smooth  Spectrum' 

CO  TO  750 
END  IF 

IF  (Icode. NE. 'N' )  GO  TO  890 

1st  Re-entry  Point  After  Performing  Smoothing  Algorithm 


900  DERIV— . TRUE. 

TITLE-’ Derivat ive  Spectrum' 
GO  TO  750 


2nd  Re-entry  Point  After  Selecting  Derivative  Algorithm 


910  WN— WMIN+WOFF  :  Set  Limits  For  Calculation 

WX-WMAX-WOFF  !  Of  Derivative  Spectrum 

START-NINT( (WMAX-WX)/STEP)+1 
FINISH-NINT (NDATA-(WN-WMIN) /STEP) 

920  WRITE  (1,*)  UP, ERASE,'  FIRST  or  SECOND  Derivative:  (F  or  S)  ?', 
&BELL,'  _' 

READ  (1,80)  Icode 
CALL  Upper (Icode) 

IF  ( Icode. EQ. 'F' )  THEN 
String-' FIRST' 

M-5 

ZR^IO.O  !  1st  Derivative  Multiplier 

GO  TO  930 
END  IF 

IF  ( Icode .NE. ’S')  GO  TO  920 
String-' SECOND' 

M— 6 

^^100.0  !  2nd  Derivative  Multiplier 


1st  Derivative  Multiplier 
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1057 

1058 

1059  C 

1060 
1061 
1062 

1063 

1064 

1065 

1066 

1067 

1068 

1069 

1070 

1071 

1072 

1073  C 

1074  C 

1075  C 

1076 

1077 

1078 

1079 

1080 
1081 
1082 

1083 

1084 

1085 

1086 

1087 

1088 

1089 

1090 

1091 

1092 

1093 

1094 

1095  C 

1096  C 

1097  C 

1098  C 

1099  C 

1100  C 

1101  C 

1102 

1103 

1104 

1105 

1106 

1107 

1108 
1109 


930  WRITE  (1,*)  UP, ERASE,’  Calculating  ’ ,String(l :M) , '  Derivative:', 

&BELL 


DO  970  I-START, FINISH 
DO  940  J-1,5 
SS(J)-0.0 
940  CONTINUE 

DO  950  K— 1 ,NPTS (L) 

XX-K-XOFF 

YY-DBLE(Y(I+XX*IS)) 
SS(1)-SS(1)+YY 
SS(2)-SS(2)+YY*DBLE(XX) 
SS(3)-SS(3)+YY*DBLE(XX**2) 
SS(4)-SS(4)+YY*DBLE(XX**3) 
SS(5)-SS(5)+YY*DBLE(XX**4) 
950  CONTINUE 


!  Zero  Summations  Array 


!  Segment  Is  (-XX.+XX): 
!  Step  Size  Is  IS*STEP 

!  Calculate  Summations 
!  For  Least  Squares  Fit 
!  Within  Segment : 


Array  CC  Holds  Known  Least  Squares  Coefficients 


IF  (Icode.EQ. 'F' )  THEN 
YY-CC(L,2)*SS(2)+CC(L,4)*SS(4) 

GO  TO  960 
END  IF 

YY-2.0D0*(CC(L,3)*SS(1)+CC(L,6)*SS(3)+CC(L,7}*SS(5)) 

960  Z(I)-SNGL(YY)/STEP/FLOAT(IS)*ZM  !  Z(I)  is  Derivative  Spectrum 
970  CONTINUE  !  Rescaled  xl0(F)  or  xi00(S) 

DO  980  /-I , START- 1 

Z(I)-Z(START)  !  Set  First  XX*IS  Points 

980  CONTINUE 

DO  990  I-FINISH+l.NDATA 

Z( I )— Z(FINISH)  !  Set  Last  XX*IS  Points 

990  CONTINUE 

WRITE  (1,*)  UP, ERASE,'  Derivative  FINISHED:  ',BELL,’_' 

CALL  Wait (1 .0) 

Dstat-' VALID' 

Dtype-Icode 
DERIV-. FALSE. 

GO  TO  500 


Store  Edited  Or  Derivative  Spectrum 


1000  IF  (Sstat(l) .NE. 'VALID' )  GO  TO  260 

IF  ((Code. EQ. 'D') .AND. (Dstat .NE. 'VALID' ))  CO  TO  2C0 
IF  (ABS (WMIN-WAVE(1 ) ) . GT . 0 . 2)  THEN 
1010  WRITE  (1,*)  UP, ERASE,'  SCAN  ENDED  AT’ , WAVE( 1 ) , 

&  '  nm  (Expected: ' ,WMIN, ') ,  Proceed  (Y  or  N)  ?  ',BELL,'_' 

READ  (1,80)  Icode 
CALL  Uppe  r ( I  code ) 

IF  (Icode.EQ. 'N' )  GO  TO  70 
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1110  IF  (Icode.NE. 'Y' )  GO  TO  1010 

1111  END  IF 

1112  HEADER-LABEL ( 1 ) 

1113  IF  (COUNT. CT.O)  THEN 

1114  NUMBER-FLOAT ( COUNT ) 

1115  CALL  Str(NUMBER, String, 2) 

1116  HEADER-' SM' //St  ring(2 : 3)//’ : ’//LABEL(l) 

1117  END  IF 

1118  String-' Edi ted' 

1119  M-6 

1120  IF  (Code.EQ. 'D' )  THEN 

1121  String-' Derivat ive' 

1122  M-10 

1123  HEADER-Dtype//' D: ' //LABEL( 1 ) 

1124  END  IF 

1125  TITLE-' Store  '//String(l :M)//’  Spectrum* 

1126  1020  WRITE  (1,*)  HOME,CLR,'_' 

1127  CALL  Center (TITLE) 

1128  CALL  Line(NCOL) 

1129  WRITE  (1,*) 

1130  WRITE  (1,*)  '  Researcher"  s  Initials,  (AA-ZZ) :  '  .BELL, '_' 

1131  READ  (1, '(A2)')  INITIALS 

1132  WRITE  (1,*)  DOWN 

1133  WRITE  (1,*)  UP, ERASE,'  Filename,  (16  chars.):  ' , BELL , ' _ ' 

1134  READ  ( 1 , '  (A16)  ' )  Fname 

1135  L— 16 

1136  DO  WHILE  (Fname(L.L) .EQ. '  ') 

1137  L-L-l 

1138  END  DO 

1139  Direct ory-Fname(l :L)//’ . S ’ //INITIALS 

1140  Fname-Directory(l :L+4) 

1141  WRITE  (1,*)  DOWN,'  Directory,  (RETURN  -  /DEFAULT/) :  '.BELL,' 

1142  READ  ( 1 , ’ (A40) ’ )  Directory 

1143  IF  (Directory. EQ. '  ’)  THEN 

1144  Fi lespec-Fname 

1145  CO  TO  1030 

1146  END  IF 

1147  K— 40 

1148  DO  WHILE  (Directory(K.K) .EQ. '  ') 

1149  K— K-l 

1150  END  DO 

1151  IF  (Di rectory(K:K) .EQ. '/' )  K-K-l 

1152  Fi lespec-Di rectory( 1 :K)//' /'//Fname 

1153  1030  K— 63 

1154  DO  WHILE  (Fi lespec(K:K) .EQ. '  ') 

1155  K-K-l 

1156  END  DO 

1157  WRITE  (1,*)  UP, ERASE,’  Validating:  ' ,Fi lespec(l :K) , ' 

1158  OPEN  (UNIT-66 , FILE— Fi lespec(l :K) , I OSTAT-N , STATUS-' NEW' ) 

1159  WRITE  (l,*) 

1160  IF  (N.NE.0)  THEN 

1161  N-N-500 

1162  WRITE  (1,*)  UP, ERASE, 
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I 

1163 

1164 

1165 

1166 

1167 

1168 

1169 

1170 

1171 

1172 

1173 

1174 

1175  C 

1176  1050  WRITE  (1 ,*)  DOWN, '  Storing  File:  ’ ,Fi lespec(l :K) .BELL 

1177  WRITE  (66.FMT-140, l OSTAT-N , ERR-1070)  HEADER 

1178  WRITE  (66, FMT-150, IOSTAT-N, ERR-1070)  DATE ( 1 ) 

1179  WRITE  (66 ,FMT-*, IOSTAT-N .ERR-1070)  WMIN , WMAX, STEP, CONC( 1 ) , PATH ( 1 ) 

1180  WRITE  (66, FMT-*, IOSTAT-N, ERR-1070)  ORD( 1 ) , ABSC( 1 ) , CELL ( 1 ) , 

1181  &CYCLE( 1 ) , SAMPLE( 1 ) ,WAVE(1) ,TIMER(1) ,TEMP(1) ,DIST(1) 

1182  WRITE  (66, FMT- 180, IOSTAT-N, ERR- 1070)  NP.NV.NDATA 

1183  WRITE  (66, FMT-190, IOSTAT-N, ERR-1070)  (PARAM( 1 , I ) , I— 1 ,NP) 

1184  WRITE  (66, FMT-*, IOSTAT-N, ERR- 1070)  ( VAR I ABLE (1 , I) , 1-1 ,NV) 

1185  IF  (Code . EQ. ' D' )  THEN 

1186  WRITE  (66, FMT-*, IOSTAT-N, ERR- 1070)  (Z( I ) , I— 1 , NDATA) 

1187  CO  TO  1060 

1188  END  IF 

1189  WRITE  (66, FMT-*, IOSTAT-N, ERR-1070)  (Y( I ) , I— 1 , NDATA) 

1190  1060  WRITE  (66, FMT-*, IOSTAT-N, ERR-1070)  (X( I ) , 1-1 .NDATA) 

1191  CLOSE  (UNIT-66, IOSTAT-N, ERR-1070, STATUS- ' KEEP ’ ) 

1192  IF  (Code.EQ. 'D' )  Ds tat-' STORED' 

1193  IF  (Code.EQ. 'S' )  Fs tat-' STORED' 

1194  CALL  Wait (2.0) 

1195  CO  TO  MENU 

1196  C  - 

1197  1070  WRITE  (1,*)  UP, ERASE,'  Disk  Error  # ' , N , BELL , ' 

1198  WRITE  (1,*)  'R... Resave,  X. . .EXIT  to  Menu  ?  ' , BELL, 

1199  READ  (1,80)  Icode 

1200  CALL  Upper (Icode) 

1201  IF  ((Icode. NE. 'R' ) .AND. (Icode. NE. 'X' ))  CO  TO  1070 

1202  WRITE  (1,*)  UP, ERASE,'  Deiet ing  Old  Fi le :  ’ , Fi lespec( 1 : K) , BELL . 

1203  &’ 

1204  CLOSE  (UNIT-66, IOSTAT-N, ERR-1070, STATUS- 'DELETE ’ ) 

1205  CALL  Wait (2.0) 

1206  IF  ( Icode. EQ. 'R' )  CO  TO  1020 

1207  Fname-'  ' 

1208  Fstat-'  ' 

1209  CO  TO  MENU 


IF  (N.EQ.2)  WRITE  (1,*)  '  FILE  EXISTS:  ',BELL,'_' 

IF  (N.EQ.8)  WRITE  (1,*)  *  FILE  OPENED:  ',BELL,'_' 

CLOSE  (66, IOSTAT-N, ERR-1070) 

CALL  Wait (2.0) 

CO  TO  1020  I 

END  IF 

IF  ( Icode. EQ. 'R' )  CO  TO  1050 
WRITE  (1,*)  DOWN,'  Title:  ' 

WRITE  (1 ,*)  '  ’ .HEADER 

WRITE  (1,*)  DOWN,'  Date:  ' ,DATE(1) 

WRITE  (1,*)  DOWN,'  Concentration,  (M) :  ',CONC(l)  I 

WRITE  (1,*)  DOWN,'  Pathl ength,  (cm):  ’,PATH(1) 
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Store  Curve  Fitting  File 


1210  C 

1211  C 

1212  C 

1213  C 

1214  C 

1215  C 

1216  C 

1217  2000  WRITE  (1,*)  HOME,CLR,'_’ 

1218  TITLE- ’Curve  Fitting  File' 

1219  CALL  Center(TITLE) 

1220  CALL  Line(NCOL)  S 

1221  WRITE  (1,*)  DOWN,'  Scan  Range:  \WMAX,'  to'.WMIN,'  nm'.DOWN, 

1222  &DOWN 

1223  2010  WRITE  (1,*)  UP, ERASE,’  File  Range:  (MIN, MAX)  ?  ',BELL,'_' 

1224  READ  (1 ,*,ERR-2010)  WN.WX 

1225  WN-ABS(WN) 

1226  WX-ABS(WX)  • 

1227  CALL  XI imits (WN.WX) 

1228  IF  ((WN.LT.WMIN) .OR. (WN.CT.WMAX))  CO  TO  2010 

1229  IF  ((WX.LT.WMIN) .OR. (WX.CT.WMAX))  CO  TO  2010 

1230  C  - - - - - 

1231  T7-1.0E7 

1232  WRITE  (1,*)  DOWN  • 

1233  2020  WRITE  (1,*)  UP, ERASE,’  #  Of  Data  Points:  (10-500)  ?  ’,BELL,'_’ 

1234  READ  (1, ' (13) ' .ERR-2020)  NFIT 

1235  IF  ((NFIT. LT. 10) .OR. (NFIT. CT. 500))  GO  TO  2020 

1236  IF  (NFIT.GT.NDATA)  THEN 

1237  WRITE  (1,*)  UP, ERASE,'  File  Has  Insufficient  #  Of  Points:  ', 

1238  &  BELL,  ' • 

1239  CALL  Wait  (2.0) 

1240  GO  TO  2020 

1241  END  IF 

1242  FIRST-T7/WX 

1243  LAST-T7/WN 

1244  SPACE-ANINT((LAST-FIRST)/FLOAT(NFIT-l ) )  • 

1245  2030  LAST— FIRST+FLOAT (NFIT-1 )*SPACE 

1246  IF  (T7/LAST.LT. WMIN)  THEN 

1247  SPACE-SPACE-1.0 

1248  CO  TO  2030 

1249  END  IF 

1250  WRITE  (1,*)  UP, ERASE, UP, UP, ERASE, * 

1251  WRITE  (1,*)  '  File  Range:  ’.FIRST,’  to', LAST,’  at’, SPACE, 

1252  &'  cm-1  steps’ .DOWN, DOWN 

1253  EMULT-1 .0 

1254  2040  WRITE  (1,*)  UP, ERASE,'  Y-scale:  ( A ...  Absorbance ,  ', 

1255  &'E. . .Ext .Coeff.)  ?  ',BELL,'_’ 

1256  READ  (1,80)  Icode  * 

1257  CALL  Upper (Icode) 

1258  IF  ( Icode. EQ. 'E' )  THEN 

1259  EMULT-1 . 0/(CONC( 1 )*PATH( 1 ) ) 

1260  WRITE  (1,*)  UP, ERASE,'  Ext. Coeff.  vs  cm-1' 

1261  CO  TO  2050 

1262  END  IF  1 
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1263  IF  (Icode.NE. 'A' )  GO  TO  2040 

1264  WRITE  (1,*)  UP, ERASE,'  Absorbance  vs  cm-1 ' 

1265  C  - - - 

1266  2050  WRITE  (1,*)  DOWN 

1267  IF  (Ymode.EQ. 'T' )  THEN 

1268  WRITE  (1,*)  UP, ERASE,'  KT  Data  ->  Absorbance' 

1269  WRITE  (1,*)  DOWN 

1270  END  IF 

1271  2060  WRITE  (1,*)  UP, ERASE,'  Filename:  ?  ',BELL,'_' 

1272  READ  (1,'(A20)’)  Fname 

1273  OPEN  (UNIT-66 , FI LE-Fname , I OSTAT-N , STATUS-' NEW' ) 

1274  IF  (N.NE.0)  THEN 

1275  N-N-500 

1276  WRITE  (1,*)  UP, ERASE, '_' 

1277  IF  (N.EQ.2)  WRITE  (1,*)  '  FILE  EXISTS:  '.BELL 

1278  IF  (N.EQ.8)  WRITE  (1,*)  ’  FILE  OPENED:  ’.BELL 

1279  CLOSE  (66, I OSTAT-N, ERR-2999) 

1280  CALL  Wait (2.0) 

1281  GO  TO  2060 

1282  END  IF 

1283  WRITE  (1,*)  UP, ERASE,'  Writing  File:  '.Fname, BELL 

1284  C  - 

1285  DO  2070  W-FIRST, LAST, SPACE 

1286  WL— ANINT (T7/W/STEP)*STEP  !  Nearest  Wavelength 

1287  I— NINT( (WMAX-WL) /STEP)+1  !  Index  Value 

1288  Xval— T7/X(I)  !  Nearest  Wavenumber 

1289  IF  (Ymode.EQ. 'A' )  THEN 

1290  Yva 1 — Y ( I ) *EMULT  !  Absorbance/Ext .CoefF.  Value 

1291  ELSE 

1292  Yval— ALOG10( 100 . 0/Y( I ) )*EMULT 

1293  END  IF 

1294  WRITE  (66,*)  Xval, Yval 

1295  2070  CONTINUE 

1296  C  - - - 

1 297  CLOSE  (66,1 OSTAT-N , ERR-2999 , STATUS- ' KEEP ’ ) 

1298  Cs tat -'STORED' 

1299  GO  TO  MENU 

1300  C  - - - - - - - 

1301  2999  WRITE  (1,*)  '  Disk  Error  #’ ,N 

1302  CALL  Wait (2.0) 

1303  Cstat-' INVALID' 

1304  GO  TO  MENU 

1305  C 

1306  C  - 

1307  C 

1308  C  Exit  Program 

1309  C 

1310  C  - - - 

1311  C 

1312  9999  IF  ( (Sstat . EQ. ' VALID' ) .AND. (Fstat . NE. ’ STORED' ) )  THEN 

1313  WRITE  (1,*)  UP, ERASE, 

1314  WRITE  (1,*)  '  Spectrum  NOT  STORED:  Exit,  (Y  or  N)  ?  ' , BELL , 

1315  READ  (1,80)  Icode 
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1316 

1317 

1318 

1319 

1320 

1321 

1322 

1323  C 

1324  C 

1325  C 

1326  C 

1327  C 

1328  C 

1329  C 

1330 

1331 

1332 

1333 

1334 

1335 

1336 

1337 

1338 

1339 

1340 

1341 

1342 

1343 

1344  C 

1345  C 

1346  C 

1347  C 

1348  C 

1349  C 

1350  C 

1351 

1352 

1353 

1354 

1355 

1356 

1357 

1358 

1359 

1360 

1361 

1362 


CALL  Upper(Icode) 

IF  ( I code . EQ. 'N' )  CO  TO  70 
IF  ( I code .NE. ' Y' )  CO  TO  9999 
END  IF 

WRITE  (1,*)  UP, ERASE, UP 

STOP 

END 

********************  ejjD  OF  MAIN  PROGRAM  *********************** 
Print  a  TITLE  Centered  in  72  columns 


******** 


SUBROUTINE  Center (TITLE) 

INTEGER  I , J ,N 

CHARACTER  TITLE*72 , BLANK*36 
BLANK-’ 

1-72 

J-0 

DO  WHILE  (TITLE(I : I) .EQ. '  ') 

J-J+l 
I-72-J 
END  DO 
N-J/2 

WRITE  (1,*)  BLANK(1 :N) ,TITLE(1 : I) 

RETURN 

END 


Print  a  line  of  N  characters  (72  columns  max) 


SUBROUTINE  Line(N) 

INTEGER  I ,N 

CHARACTER  BLANK*72 , DLINE*72 , SPACE*36 
SPACE-' 

BLANK— SPACE//SPACE 

SPACE-' - 

DL I NE-S  PACE//S  PACE 
IF  (N.GT.72)  N-72 
I-(72-N)/2 

WRITE  (1,*)  BLANK (1:1)  DL I NE ( 1 : N ) 

RETURN 

END 
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1363  C 

1364  C  - 

1365  C 

1366  C  Validate  Abscissa  Limits 

1367  C 

1368  C  - - - - 

1369  C 

1370  SUBROUTINE  XI imi ts(MIN.MAX) 

1371  REAL  MIN, MAX, SWAP 

1372  MIN-ABS(MIN) 

1373  MAX-ABS(MAX) 

1374  IF  (MIN. LT. MAX)  GO  TO  10 

1375  SWAP— MIN 

1376  MIN-MAX 

1377  MAX-SWAP 

1378  10  RETURN 

1379  END 

1380  C 

1381  C  - - - - - - - 

1382  C 

1383  C  Validate  Ordinate  Limits 

1384  C 

1385  C  - - - - 

1386  C 

1387  SUBROUTINE  Ylimits(MIN, MAX) 

1388  REAL  MIN, MAX, SWAP 

1389  IF  (MIN. LT. MAX)  GO  TO  10 

1390  SWAP— MIN 

1391  MIN-MAX 

1392  MAX-SWAP 

1393  10  RETURN 

1394  END 

1395  C 

1396  C  - 

1397  C 

1398  C  Convert  String  Entry  To  Upper  Case  If  Required 

1399  C 

1400  C  - 

1401  C 

1402  SUBROUTINE  Upper (Code) 

1403  INTEGER  LENSTR.N 

1404  CHARACTER* (*)  Code 

1405  LENSTR-LEN ( Code ) 

1406  DO  10  I— 1 , LENSTR 

1407  N— I  CHAR  (Code  (I :  I)) 

1408  IF  (N.CT.96)  Code( I : I )-CHAR(N-32) 

1409  10  CONTINUE 

1410  RETURN 

1411  END 
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Convert  ASCII  String  To  Numeric  Value  (10  Digits  Max'm) 


1412  C 

1413  C 

1414  C 

1415  C 

1416  C 

1417  C 

1418  C 

1419 

1420 

1421 

1422 

1423 

1424 

1425 

1426 

1427 

1428  C 

1429 

1430 

1431 

1432 

1433 

1434 

1435 

1436 

1437 

1438  C 

1439  C 

1440 

1441 

1442 

1443 

1444 

1445 

1446 

1447 

1448 

1449 

1450 

1451 

1452 

1453 

1454 

1455 

1456 

1457 

1458 

1459 

1460 

1461 

1462 

1463 


' .String 
, LENSTR 


SUBROUTINE  Val (String, VALUE) 

INTEGER  DECPT.EXPON, LENSTR, M,N,NUM( 12) ,EX(3) 
REAL  VALUE 

DOUBLE  PRECISION  ES ICN, MULT, S ICN, TEN, DECIMAL 

CHARACTER  Ascii 

CHARACTER* ( * )  String 

LOGICAL  EXPONENT, INTEGER, TEST 

EXPONENT-. FALSE. 

INTEGER-. TRUE. 

TEST-. FALSE. 

J-l 

K-0 

M-0 

DECPT-0 

ESIGN-1.0 

SIGN— 1 .0 

TEN-10.0 

DECIMAL-0.0 

LENSTR-LEN(String) 

IF  (TEST)  WRITE  (1,*)  '  String  Number  -  ',Str 
IF  (TEST)  WRITE  (1,*)  •  String  Length  —  ’  ,LENS 
DO  100  I -1, LENSTR 
Asci i-Str ing( 1:1) 

N-ICHAR(Ascii) 

IF  (N.EQ.69)  THEN 
EXPONENT-. TRUE. 

IPOS- I 
GO  TO  100 
END  IF 

IF  (EXPONENT)  CO  TO  30 

IF  ((N.GE.48) .AND. (N.LE.57))  GO  TO  20 

IF  (N.EQ.46)  INTEGER-. FALSE. 

IF  (N.EQ.46)  DECPT-K 
IF  (N.EQ.45)  SIGN— 1.0 
GO  TO  100 
20  NUM(J)— N-48 
K-J 
J-J+l 
GO  TO  100 

30  IF  (N.EQ.45)  ESIGN— 1.0 

IF  ((N.LT.48) .OR. (N.CT.57))  CO  TO  100 

EX(I-IPOS)-N-48 

M-M+l 

100  CONTINUE 

IF  ((DECPT.EQ.0) .AND. (INTECER))  DECPT-K 


1464  DO  200  J-l.K 

1465  EXPON-DECPT-J 

1466  MULT-TEN** EXPQN 

1467  DEC I MAL-DEC I MAL+NUM ( J ) *MULT 

1468  200  CONTINUE 

1469  DEC I MAL-S I CN*DEC I MAL 

1470  MULT-0.0 

1471  IF  (ESICN.EQ.-1.0)  M-M+l 

1472  DO  300  I-l.M 

1473  MULT-MULT+DBLE ( EX ( I ) ) *TEN** ( M- I ) 

1474  300  CONTINUE 

1475  VALUE-DEC I MAL*TEN**(ES I GN*MULT) 

1476  C  IF  (TEST)  WRITE  (1,*)  •  Value  -'.VALUE 

1477  RETURN 

1478  END 
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r  . 

1479  C 

] 

1480  C 

■ 

1481  C 

1482  C 

Convert  Number  To  ASCII  String 

I 

1483  C 

mm 

1484  C 

■ 

1485  C 

I 

1486 

SUBROUTINE  Str(VALUE, String, PREC) 

1 

1487 

INTEGER  ASCII ,DECPT , I , J , LENSTR.NDIGIT, NUMBER, PREC 

1 

1488 

REAL  VALUE 

1 

1489 

DOUBLE  PRECISION  DECIMAL, FRACTION, TEN 

JM 

1490 

CHARACTER  Concat*14 , Digit(l2) , S ign, St r ing*14 

J 

1491 

LOGICAL  INTEGER, TEST 

1 

1492 

INTEGER-. TRUE. 

1 

1493  C 

TEST-. FALSE. 

1 

1494 

DECPT-0 

1 

1495 

J— 0 

•1 

1496 

TEN-10.0 

■ 

1497 

Sign-’  ' 

1 

1498 

Concat-'  ' 

1 

1499  C 

IF  (TEST)  WRITE  (1,*)  '  Value  Entered  -  ’.VALUE 

1 

1500 

IF  (VALUE.LT. 0.0)  Sign-’-' 

1501 

IF  (VALUE. EQ. 0.0)  GO  TO  100 

•1 

1502 

DEC I MAL-ABS (VALUE ) 

■ 

1503 

DO  WHILE  (DECIMAL. CE. 1.0) 

1 

1504 

DEC I MAL-DEC I MAL/TEN 

I 

1505 

J-J+l 

1 

1506 

END  DO 

1 

1507 

DECPT-J 

•1 

1508  C 

IF  (TEST)  WRITE  (1,*)  '  #  of  Whole  Digits:  ’ , DECPT 

1 

1509 

IF  (DECPT. EQ.0)  GO  TO  30 

I 

1510 

DO  20  J-l, DECPT 

1 

1511 

DEC I MAL-DEC I MAL*TEN 

1 

1512 

NUMBER- I NT ( DEC I MAL ) 

I 

1513 

ASCI  I— NUMBER+48 

•1 

1514 

Digit (J)— CHAR (ASCI  I ) 

1 

1515 

FRACT I ON-DEC I MAL-NUMBER 

1 

1516 

DEC I MAL-D I NT ( FRACT I ON*TEN** ( PREC- J ) + . 5 ) /TEN** ( PREC - J ) 

1517 

20  CONTINUE 

1518  C 

IF  (.NOT. TEST)  GO  TO  30 

1519  C 

WRITE  (1,*)  ’  The  Whole  Digits  -  '.(Digit(l),  1-1, DECPT) 

• 

1520 

30  J— DECPT 

1521  C 

IF  (TEST)  WRITE  (1,*)  '  Decimal  Fraction  -  ’.DECIMAL 

1522 

IF  (DECIMAL. NE. 0.0)  INTEGER-. FALSE. 

1523 

IF  (DECPT. GE. 12)  GO  TO  40 

1524 

DO  WHILE  (DECIMAL. NE. 0.0) 

1525 

J-J+l 

• 

1526 

DEC I MAL-DEC I MAL*TEN 

1527 

NUMBER- I NT ( DEC I MAL ) 

1528 

ASCI  I -NUMBER+48 

1529 

Digit ( J )— CHAR (ASCI  I ) 

1530 

FRACT I ON-DEC I MAL-NUMBER 

1531 

DEC I MAL-D I NT ( FRACT I ON*TEN** ( PREC - J ) + . 5 ) /TEN** ( PREC - J ) 

•• 
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•i 

J 

j 

1 

J 

1532 

IF  (DECIMAL. EQ. 1 .0)  THEN 

1533 

DIGIT(J)-CHAR(ASCI 1+1 ) 

1534 

DECIMAL-0.0 

1535 

END  IF 

1536 

IF  (J.CE.12)  DECIMAL-0.0 

1537 

END  DO 

1538 

40 

NDICIT-J 

1539  C 

IF  (.NOT. TEST)  CO  TO  50 

1540  C 

WRITE  (1,*)  •  The  Characters  -  \(Digit(I),  I-l.NDICIT) 

1541 

50 

IF  (NDICIT.GT. 12)  CO  TO  200 

1542 

DO  60  I-l.NDICIT 

1543 

Concat ( I : I )— Di gi t ( I ) 

1544 

60 

CONTINUE 

1545 

IF  (INTEGER)  GO  TO  80 

1546 

IF  (DECPT.EQ.0)  CO  TO  70 

1547 

S  t  r 1 ng-S i gn//Conc  at ( 1 : DECPT )//'.' //Conca  t ( DECPT+ 1:14) 

1548 

RETURN 

1549 

70 

String-Sign//’ . '//Concat 

1550 

RETURN 

1551 

80 

S t  r i ng-S i gn//Concat 

1552 

RETURN 

1553 

100 

String-'  0.0' 

1554 

RETURN 

1555 

200 

WRITE  (1,*)  '  Error  in  data:  (too  many  digits)' 

1556 

STOP 

1557 

END 
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Wait  Specified  Delay  (sec) 


1558  C 

1559  C 

1560  C 

1561  C 

1562  C 

1563  C 

1564  C 

1565  SUBROUTINE  Wait (DELAY) 

1566  REAL  DELAY, PER I OD,Tzero, Time 

1567  PERIOD-O.O 

1568  Tzero-Time(l) 

1569  DO  WHILE  (PERIOD. LT. DELAY) 

1570  PERIOD-Time(I)-Tzero 

1571  END  DO 

1572  RETURN 

1573  END 

1574  C 

1575  C  - - - - - 

1576  C 

1577  C  Read  Time  (sec)  from  the  HP  1000' s  RTE-6  Operating  System 

1578  C 

1579  C  Note:  I  is  a  dummy  argument,  no  values  are  passed 

1580  C 

1581  C  - - - 

1582  C 

1583  REAL  FUNCTION  Time(I) 

1584  INTEGER  ICODE, ITIME(5) 

1585  I CODE-11 

1586  CALL  EXEC (I CODE, I TIME) 

1587  Time— FLOAT ( ITIME( 1 ) )/100 . 0+FLOAT ( ITIME(2) )+FLOAT ( ITIME( 3) )*60 . 0 

1588  &+FLOAT( ITIME(4) )*3600 . 0 

1589  RETURN 

1590  END 


I 
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Appendix  I 

Sample  Smoothed  Spectra 
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gth  (nm) 


Noisy  Diffuse  Reflectance  Spectrum 
Smoothed  With  25  Point  Fit,  200  nm  Range 


Wavenumber 


Appendix  II 

Sample  Derivative  Spectra 
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s*  No  Smoothi 


30NV8d0Sgv 
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Wavelength  (nm) 


Second  Derivative.  7  Point  Fit.  3  nm  Segments.  No  Smoothing 
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300  400  500  600  700 

Wavelength  (nm) 


Second  Derivative,  7  Point  Fit.  24  nm  Segments,  No  Smoothing 


Wavelength  (nm) 


